Re: reduce code execution time
Posts by mathew31
-
-
-
Re: reduce code execution time
ok pike,u see my code above how do u propose i move ahead ?
warm regards,
mathew -
Re: reduce code execution time
hello pike,
i appreciate your suggestion,but this is just a base code i have more stuff that i need to add so i cant do that..
cheers
mathew -
Hello all,
the below macro is used to compare the employees project date with the days which are populated in a multiple columns and give a count of how many current assignments an employee is working on a particular day.
for eg:- if RAnge Q3:Au3 is filled with dates of october 2013,
like q3:1st oct,r3:2nd oct,s3:3rd oct and so on.
my code is comparing these individual dates with the employees start and end date from sheet temp calc and returns a count of the no of assignments the employee is working on by counting the employee id. the code works fine but it takes ages for execution(beacuse there are around 50 thousand employees)
ive then applied filters after i get the data into the sheet in the first place to delete redundant data such as withdrawn,inactive and other employees.also another filter to remove employees that do not fall in my compare range but the employees is still huge and excution time is also large.
could someone explain how i can reduce the project execution time and any where i can clean up the code for faster execution because the data is only going to increase.in case i could not provide enough details i've attached my file in the link below please have a look.
https://docs.google.com/file/d/0B2CrBt…dit?usp=sharing
Code
Display MoreOption Explicit Sub Count() ' x= no of columns(dashboard calender) ' y= no of rows(dashboard emp id) ' z= no of rows(temp calc sheet emp id) Application.ScreenUpdating = False 'Clear calender data Range("Q4").Select Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select Selection.ClearContents Dim i, j, k, l, d, x, y, z, Empid As Long Dim currentdate, startdate, enddate As Date x = (Range("n2") - Range("n1")) + 1 y = Application.WorksheetFunction.counta(Range("A:A")) - 1 z = Application.WorksheetFunction.counta(Worksheets("Temp Calc").Range("A:A")) - 1 For i = 1 To y Step 1 'To loop through the emp_id in dashboard. For j = 1 To x Step 1 'To loop through the calender in dashboard daywise. d = 0 For k = 1 To z Step 1 'To loop through the emp_id i temp calc sheet. Empid = ActiveSheet.Cells(i + 3, 1).Value currentdate = Cells(3, 16 + j).Value startdate = Worksheets("Temp calc").Cells(k + 1, 3).Value enddate = Worksheets("Temp calc").Cells(k + 1, 4).Value If (Worksheets("Temp calc").Cells(k + 1, 1).Value) = Empid Then If (currentdate >= startdate) And (currentdate <= enddate) Then 'To check whether the first column date falls within the project start and end date d = d + 1 End If End If Next Worksheets("Dashboard").Cells(i + 3, j + 16) = d Next Next Range("q4").Select Application.ScreenUpdating = True End Sub
-
-
-
Re: count the number of columns until the first blank cell is encountered.
hello Smallman,
[ATTACH=CONFIG]54641[/ATTACH]
yea i get that , sorry for being so vague
as you see in the image posted i want the count function to count from a3 to o3,but there are still files after p3 i do not want the count for them.
the code i have posted does that.
does this help.Warm Regards,
Mathew -
Re: count the number of columns until the first blank cell is encountered.
hello smallman,
no that is not what i meant, basically from row 3 in column a i have around 47 columns, now the code which i have posted returns the number.
what i wish to achieve is a count of the column till a blank cell is encountered (the count now till blank cell is 14. i do want to set the number as 14 as the count keeps changing), since everything after that is irrelevant to me.warm regards,
Mathew
-
-
-
-
Re: copy entire columns from multiple workbooks(one sheet each) to a main workbook sh
yea mate those headers are the ones i wish to copy. The thing is i can do it for a single file no problem, but when i am unable to do it for multiple file.and then even if it does work, i am not sure how to use the offset or the xlDown function to put the data below the existing data.
this is the code that works for me with a single file.
Code
Display MoreSub copyCompare() Sheets("Temp Calc").Select 'Clear existing sheet data except headers Rows(1).Offset(1, 0).Resize(Rows.Count - 1).ClearContents Dim lastCol, lastRow As Long, k As Long, a As Variant, b As Variant, cmpRng As Range Dim mastCol As Long, mastRng As Range, n As Long Dim Wbk As Workbook Application.ScreenUpdating = False Worksheets("Temp Calc").Select lastCol = Worksheets("Temp Calc").Cells(1, Columns.Count).End(xlToLeft).Column lastRow = Worksheets("Temp Calc").Cells(Rows.Count, 1).End(xlDown).Row Set cmpRng = Range(Cells(1, 1), Cells(1, lastCol)) a = cmpRng Set Wbk = Workbooks.Open("G:\work\APAC-Personal Assignment.xlsx") Worksheets("Sheet1").Select mastCol = Cells(1, Columns.Count).End(xlToLeft).Column Set mastRng = Range(Cells(1, 1), Cells(1, mastCol)) b = mastRng For k = 1 To lastCol For n = 1 To mastCol If UCase(a(1, k)) = UCase(b(1, n)) Then [B] Windows("APAC-Personal Assignment.xlsx").Activate ' this statement is what i use to activate the book.'[/B] Worksheets("Sheet1").Range(Cells(2, n), Cells(lastRow, n)).Copy Windows("Dashboard_for_Roshan.xlsm").Activate Worksheets("Temp Calc").Select Cells(2, k).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Exit For End If Next Next Application.ScreenUpdating = True Exit Sub End Sub
now in the previous post thread i put up i was storing the names of the files in an array, how do i refer to it one at a time, will this do the trick -----
workbooks(Filename(i)).open
i is the loop counter and Filenames is the array returned by the get open file name -
Re: copy entire columns from multiple workbooks(one sheet each) to a main workbook sh
Quote from jolivanes;671080Had a quick look at Sheet1 of APAC-Personal Assignment and Sheet Temp Calc of Dashboard_for_Roshan and to me the headers don't look similar at all. The only header that seems to be the same is Employee (nr?)
I would suggest to set your sheets up so that you could just say: If Range("A1").Value = "Employee" Then copy the whole column to the other sheet.
If you setup your sheets properly, it'll make your life a whole lot easier.no dude check again those headers were taken from apac only
-
Re: copy entire columns from multiple workbooks(one sheet each) to a main workbook sh
Quote from jolivanes;671043mathew31
You'll never learn if you don't ask questions.
In the attached workbook there are several ways of selecting, incl CurrentRegion. Try them and see what they do.
If you tell us what you want copied from each sheet then it will be easier. i.e. from cell A1 to the last cell in the last used column or whatever.basically what happens is that im comparing headers from temp calc sheet to other workbooks and if they match im am copying the whole column. iam storing the file names in a header but i am unable to reference it, to run it on a loop so that it runs for a single workbook at a time.the updated code is below.....
ur suggestions on how to improve my code and learn different methods to achieving the same is highly appreciated. thank you for being patient. in the attached files dashboard is my master file where temp calc is the sheet, whose headers im comparing with apac and other such files. another problem is after pasting the data from the first files into temp calc sheet i want the second workbook data to be pasted below the existing data, now im aware of the offset and xlUp function but the extent of my knowledge is only based on a single selected row or cell. is there another way i can paste the compared data.Code
Display MoreSub Test() Dim lastCol, lastRow As Long, k As Long, a As Variant, b As Variant, cmpRng As Range Dim mastCol As Long, mastRng As Range, n As Long Dim Wbk As Workbook Dim fileone Dim SelectedFiles As Object Dim Fileame As Variant Dim indx As Long Application.ScreenUpdating = False Sheets("Temp Calc").Select 'Clear existing sheet data except headers Rows(1).Offset(1, 0).Resize(Rows.Count - 1).ClearContents Filename = Application.GetOpenFilename _ (FileFilter:=Filt, _ FilterIndex:=FilterIndex, _ Title:=Title, _ MultiSelect:=True) For i = 1 To UBound(Filename, 1) Worksheets("Temp Calc").Select lastCol = Worksheets("Temp Calc").Cells(1, Columns.Count).End(xlToLeft).Column lastRow = Worksheets("Temp Calc").Cells(Rows.Count, 1).End(xlDown).Row Set cmpRng = Range(Cells(1, 1), Cells(1, lastCol)) a = cmpRng mastCol = Cells(1, Columns.Count).End(xlToLeft).Column Set mastRng = Range(Cells(1, 1), Cells(1, mastCol)) b = mastRng For k = 1 To lastCol For n = 1 To mastCol If UCase(a(1, k)) = UCase(b(1, n)) Then [B][I][U] "this is where i want to use the names stored in the array and run the files one at a time " [/U][/I][/B] Worksheets("Sheet1").Range(Cells(2, n), Cells(lastRow, n)).Copy Windows("Dashboard_for_Roshan.xlsm").Activate Worksheets("Temp Calc").Select Cells(2, k).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Exit For End If Next Next Next 'Else 'End If Application.ScreenUpdating = True Exit Sub 'Next End Sub
-
-
Hello all,
i am trying to copy entire columns from 3 workbooks(only one sheet from each) and put them in my master file "dashboard" and sheet "temp Calc". I've got this code online, to copy column data from apac workbook into dashboard "temp calc" but it does not work. And what changes should i make to include workbook "NA" and "EU", so that the data from those workbooks are pasted below the existing data. i've attached the files from reference and the column headers in apac,na, and eu are the same. please guide me on how i should achieve this
Code
Display MoreSub copyCompare() Sheets("Temp Calc").Select 'Clear existing sheet data except headers Rows(1).Offset(1, 0).Resize(Rows.Count - 1).ClearContents Dim lastCol As Long, k As Long, a As Variant, b As Variant, cmpRng As Range Dim mastCol As Long, mastRng As Range, n As Long Application.ScreenUpdating = False lastCol = Worksheets("Temp Calc").Cells(1, Columns.Count).End(xlToLeft).Column Worksheets("Temp Calc").Select Set cmpRng = Range(Cells(1, 1), Cells(1, lastCol)) a = cmpRng Worksheets("Sheet1").Select mastCol = Cells(1, Columns.Count).End(xlToLeft).Column Set mastRng = Range(Cells(1, 1), Cells(1, mastCol)) b = mastRng For k = 1 To lastCol For n = 1 To mastCol If UCase(a(1, k)) = UCase(b(1, n)) Then Worksheets("Sheet1").Columns(n).Copy Worksheets("Sheet2").Select Cells(1, k).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Exit For End If Next Next Application.ScreenUpdating = True Exit Sub End Sub End Sub