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…EWHYycTg/edit?usp=sharing
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