Q: Maintaining a "library" with new data 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


A: 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.

A: 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.
