Maintaining a "library" with new data - excel

Question

So I am trying to maintain a library I have in excel. My library is kinda identical to the table shown below. This will store data for several year on 45000 lines. But every month i extract new hours which I want to include in the data. Though it is possible to change data back in time, so I am always extracting T, t-1, t-2, and t-3. So first I want to take last months data and subtract it from my library, load in new data, and then add on the new hours. But with the new data there will always be new Combinations, which I want to add in the bottom of the library. I have tried to solve this, and came to a solution, but it took forever as I have a big library but also extracting 85k lines every month. The reason for the combination is that several people can list time on a proj, but I do not care who does it, just the combination of these things. This is also why I fewer lines in my library. Can anybody help me? I provided the code I have made, which is doing the correct thing, but is way to slow.
Combination
Hours
ProjID
Planning
Approval
Month
Year
Hour type
Charge status
Proj1Planned42022Fixed
12
Proj1
Planned
4
2022
Fixed
Sub UpdateHours()
Dim data1 As Variant, data2 As Variant
Dim StartTime As Double
Dim MinutesElapsed As String
Application.ScreenUpdating = False
StartTime = timer
lastRow = Worksheets("TimeReg_Billable").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).row
lastRowTRB = Worksheets("TimeRegistrations_Billable").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).row
data1 = Worksheets("TimeReg_Billable").Range("A2:I" & lastRow).Value
data2 = Worksheets("TimeRegistrations_Billable").Range("A2:W" & lastRowTRB).Value
For i = 1 To lastRow
If i > UBound(data1, 1) Then Exit For
For k = 1 To lastRowTRB
If k > UBound(data2, 1) Then Exit For
If data1(i, 1) = data2(k, 23) Then
data1(i, 2) = data1(i, 2) - data2(k, 15)
End If
Next k
Next i
Worksheets("TimeReg_Billable").Range("A2:I" & lastRow).Value = data1
'Load data
'Workbooks.Open "C:\Users\jabha\Desktop\Projekt ark\INSERTNAMEHERE.xls"
'Workbooks("INSERTNAMEHERE.xls").Worksheets("EGTimeSearchControllingResults").Range("A:AA").Copy _
Workbooks("Projekt.xlsm").Worksheets("TimeRegistrations_Billable").Range("A1")
'Workbooks("INSERTNAMEHERE.xls").Close SaveChages = False
'Insert the new numbers
lastRow = Worksheets("TimeReg_Billable").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).row
lastRowTRB = Worksheets("TimeRegistrations_Billable").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).row
myarray = Worksheets("TimeReg_Billable").Range("A2:A" & lastRow)
data1 = Worksheets("TimeReg_Billable").Range("A2:I" & lastRowTRB).Value
data2 = Worksheets("TimeRegistrations_Billable").Range("A2:W" & lastRowTRB).Value
i = 1
Do While i <= lastRow
If i > UBound(data1, 1) Then Exit Do
k = 1
Do While k <= lastRowTRB
If k > UBound(data2, 1) Then Exit Do
If data1(i, 1) = data2(k, 23) Then
data1(i, 2) = data1(i, 2) + data2(k, 15)
End If
If Not data1(i, 1) = data2(k, 23) Then
Teststring = Application.Match(data2(k, 23), myarray, 0)
If IsError(Teststring) Then
data1(lastRow, 1) = data2(k, 23)
data1(lastRow, 3) = data2(k, 11)
data1(lastRow, 4) = data2(k, 16)
data1(lastRow, 5) = data2(k, 17)
data1(lastRow, 6) = data2(k, 20)
data1(lastRow, 7) = data2(k, 21)
data1(lastRow, 8) = data2(k, 22)
data1(lastRow, 9) = data2(k, 7)
lastRow = lastRow + 1
myarray = Application.Index(data1, 0, 1)
End If
End If
k = k + 1
Loop
If data1(i, 9) = "#N/A" Then
data1(i, 9) = ""
End If
i = i + 1
Loop
Worksheets("TimeReg_Billable").Range("A2:I" & lastRowTRB).Value = data1
MinutesElapsed = Format((timer - StartTime) / 86400, "hh:mm:ss")
MsgBox "This code ran succesfully in " & MinutesElapsed & " minutes", vbInformation
End Sub

Answer 1

Your code only turns off ScreenUpdating but, since the line below
Worksheets("TimeReg_Billable").Range("A2:I" & lastRow).Value = data1
updates a worksheet after the first set of nested loops it potentially triggers Excel's calculation engine to run, so it would be sensible, at the outset, also to include the line
Application.Calculation = xlCalculationManual
While I don't have any evidence for it, UsedRange.Find should, in theory, be more efficient than Cells.Find since the UsedRange is, necessarily, a much smaller area of the worksheet.
It is also more efficient to use .Value2 than .Value.
The code below
For i = 1 To lastRow
If i > UBound(data1, 1) Then Exit For
For k = 1 To lastRowTRB
If k > UBound(data2, 1) Then Exit For
If data1(i, 1) = data2(k, 23) Then
data1(i, 2) = data1(i, 2) - data2(k, 15)
End If
Next k
Next i
could be improved by the declaration of 2 additional variables
Dim outerLimit as Long, innerLimit as Long
outerLimit = Application.Min(lastRow, UBound(data1,1))
innerLimit = Application.Min(lastRowTRB, UBound(data2,1))
For i = 1 To outerLimit
For k = 1 To innerLimit
If data1(i, 1) = data2(k, 23) Then
data1(i, 2) = data1(i, 2) - data2(k, 15)
End If
Next k
Next i
which eliminates 1 test from the inner-loop body and 1 test from the outer-loop body.
(since you have similar tests in your 2nd set of nested loops you can replicate this optimisation there also)
In your 2nd set of nested loops you could replace the code below
If data1(i, 1) = data2(k, 23) Then
data1(i, 2) = data1(i, 2) + data2(k, 15)
End If
If Not data1(i, 1) = data2(k, 23) Then
with that below
If data1(i, 1) = data2(k, 23) Then
data1(i, 2) = data1(i, 2) + data2(k, 15)
Else
(obviously also deleting one of the later End If lines)
since the data1(i, 1) = data2(k, 23) test is Boolean, such that it only needs to be evaluated once.
They're the improvements I would suggest for your code, but I would also question your approach:
In the first set of nested loops the code is, effectively, testing every cell in column A of TimeReg_Billable for equality with every cell in column W of TimeRegistrations_Billable - with 85k rows this is potentially over 7 billion loop iterations (!).
Based on the sample table you posted, while you may have 85k unique rows, I don't believe you have 85k unique values in either of those 2 columns. Accordingly, I would suggest
using an Advanced Filter to isolate the unique values in columns O through W of TimeRegistrations_Billable on a new worksheet
loop through each of the unique items in column W of TimeRegistrations_Billable, making it the filter criterion for an AutoFilter of column A of TimeReg_Billable
loop through each of the SpecialCells(xlCellTypeVisible) in column A of TimeReg_Billable and make the required updates (using .Offset() as necessary)
you will likely have far fewer than 7 billion loop iterations, and you won't have to do any testing because, if a cell is one of the visible cells then it has, by definition, already satisfied the test.
Your 2nd set of nested loops is more involved, but is broadly using similar logic, such that I believe you can also use filtering to your advantage there too.

Answer 2

FYI
Teststring = Application.Match(data2(k, 23), myarray, 0)
will be quite slow compared to
Dim rng As Range
Set rng = Worksheets("TimeReg_Billable").Range("A2:A" & lastRow)
'...
'...
Teststring = Application.Match(data2(k, 23), rng, 0)
Match() against a worksheet range is much faster than against an array. See (eg) https://stackoverflow.com/a/61396675/478884 or this:
Sub Tester()
Const DATA_ROWS As Long = 50000
Dim i As Long, rng As Range, t, arr, m
'create some test data....
For i = 1 To DATA_ROWS
Cells(i, 1).Value = "Val_" & Format(i, "0000000")
Next i
Set rng = Range("A1:A" & DATA_ROWS)
t = Timer
arr = rng.Value
For i = 1 To 1000
m = Application.Match("Val_" & Format(i, "0000000"), arr, 0)
Next i
Debug.Print "Array", Timer - t
DoEvents
t = Timer
For i = 1 To 1000
m = Application.Match("Val_" & Format(i, "0000000"), rng, 0)
Next i
Debug.Print "Range", Timer - t
End Sub
output:
Array 9.148438
Range 2.734375E-02
The more data you have, the bigger the difference between the two methods.