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.
Option 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