Re: reduce code execution time
ohk jin but please do i wish to learn this
i meant should i write a separate code to do this ?
Re: reduce code execution time
ohk jin but please do i wish to learn this
i meant should i write a separate code to do this ?
Re: reduce code execution time
I don't understand what you are saying but just rename the "test".
I don't recommend to use "Count" as a procedure name, coz it is a vb reserved word.
I'm going off line now, so tomorrow.
Re: reduce code execution time
ohk
Re: reduce code execution time
1) My understanding:[INDENT]- "Dashboard" has "Emp Id" with "Startdt" and "Finishdt" for each assignment.[/INDENT]
[INDENT]- "Temp Calc" has selected "Employee" and "Start Date" and "End Date" that indicates the dates of list.
- Add 1 to the corresponding cell when any date of "Temp Calc" matches any date falls in between "Startdt" and "Finishdt".
[/INDENT]
If you write a code to do above using only Loop or Find method, it costs too much because you have so many rows as you have mentioned somewhere in the beginning of this thread.
2 points to speed up the process in this case is--
[INDENT]- Speed up the Loop. (use of array variable to store data)
- Minimize the number of Loop. (use of Dictionary object to store needed info)
- Avoid too may access to Cells/Range object to Read/write the values. (most important factor)
[/INDENT]
Sub test()
Dim a, i As Long, ii As Long, dic As Object, w, e, s
Dim StartDate As Date, EndDate As Date
Set dic = CreateObject("Scripting.Dictionary")
' use dic as a "mother dictionary" object to store unique "Employee" info.
dic.CompareMode = 1
' set compare mode to case-insensitive.
a = Sheets("temp calc").Cells(1).CurrentRegion.Value
' store whole data in "Temp Calc" to variable "a" to speed up the process.
For i = 2 To UBound(a, 1)
' commence loop from row 2.
If Not dic.exists(a(i, 1)) Then
Set dic(a(i, 1)) = CreateObject("Scripting.Dictionary")
' set child dictionary to each unique "Emp Id"
End If
If Not dic(a(i, 1)).exists(a(i, 3)) Then
Set dic(a(i, 1))(a(i, 3)) = _
CreateObject("Scripting.Dictionary")
' set child child dictionary to each unique "Startdt" to unique "Emp Id"
End If
dic(a(i, 1))(a(i, 3))(a(i, 4)) = dic(a(i, 1))(a(i, 3))(a(i, 4)) + 1
' add 1(count) to a unique set of "Emp Id", "Startdt" and "Finishdt", so that it enables to count as
' different match even if multiple same unique set of "Emp Id", "Startdt" and "Finishdt" appears.
Next
With Sheets("dashboard")
StartDate = .[N1].Value: EndDate = .[N2].Value
With .Range("a3").CurrentRegion.Resize(, .Rows(3).Find("*", , , , xlByRows, xlPrevious).Column)
' finding the data range, cos you have blank column within the data range.
.Columns("q").Resize(.Rows.count - 3, .Columns.count - 16).Offset(3).Value = 0
' initialize the values in result range set to "0".
a = .Value
' store whole data range to an array "a"
For i = 4 To UBound(a, 1)
' commence loop from row 4.
If dic.exists(a(i, 1)) Then
' when mother dictionary finds "Employee"
For Each e In dic(a(i, 1))
' loop each "Startdt"
For Each s In dic(a(i, 1))(e)
' loop corresponding "Finishdt"
If (e <= EndDate) * (s >= StartDate) Then
' when "Startdt" <= EndDate and "Finishdt" >= StartDate
For ii = 17 To UBound(a, 2)
' commence loop from col.Q
If (a(3, ii) >= e) * (s >= a(3, ii)) Then
' when date in the list matches to date between "Startdt" and "Finishdt"
a(i, ii) = a(i, ii) + dic(a(i, 1))(e)(s)
' add its count to corresponding place in array "a"
End If
Next
End If
Next
Next
End If
Next
.Value = a
' dump whole data to a range.
End With
End With
End Sub
Display More
Special note:
I have changed the line
to
to check if the date(s) between "Startdt" and "Finishdt" falls in the dates between "Start Date" and "End Date".
Re: reduce code execution time
Good morning Jindon,
one small misunderstanding the dashboard contains all the emp id and the user compare date range.
temp calc has the employee's assignment data so what i wish to do is...
using the emp id in dashboard as a reference i must traverse temp calc sheet and find out the number of times the emp id is present and return a count against the employee in the dashboard sheet under the days you can see for the number of times it falls in between the compare date only/......
is this what you are saying?/
Re: reduce code execution time
OOps, I wrote it other way around in explanation, but the code is doing what you said.
Re: reduce code execution time
jindon this is awesome. you just saved me a ton of time!
ty sir..
one additional query can the first macro "update" be run in an array only the deletion part
Re: reduce code execution time
You need to open a new thread for this and better post a workbook with your desired result as well as relevant files to show what you are trying to do.
Re: reduce code execution time
Quote...You need to open a new thread for this
Not before this got to be the longest thread on the board...
Re: reduce code execution time
Quote from cytop;673830Not before this got to be the longest thread on the board...
Agreed.... and it surprises me that it took so long...
Don’t have an account yet? Register yourself now and be a part of our community!