Sluggish Loop Transferring Dictionary Data to Spreadsheet

Question

I've added a timer to my code and the bottleneck comes when I'm looping through 47 rows and inputting data from a dictionary that I previously loaded with values.

Since i use these files for a lot of different things I've set up public variables in order to avoid setting them up for every new code.

So my question is, is there a quicker way to pull data from the dictionary based on criteria in specific cells? The line directly below is repeated 8 times for the 8 different columns being populated with dictionary data, each column takes .20 seconds to complete, so 1.6 seconds per each iteration in the w loop (orderStart to orderEnd).

Cells(w, OF_clearanceColumn1) = stationclearanceData(Cells(w, OF_stationColumn).Value & Cells(orderStart - 1, OF_clearanceColumn1).Value)

Timer stats:

3.4453125 Open client database, determine which account we're on
3.484375 Find last 4 weks and order range
7.31640625 Adding columns and formating
7.61328125 loop through last 4 weeks, add station clearance and P&L data to dictionary
7.6484375 find range of cumulative, add clearance and P&L for 2019
100.90234375 adding data from dictionary to order file

NEW TIMER STATS, THANKS TO AJD AND MOVING DATA FROM DICTIONARY TO ARRAY TO RANGE.

1.71875 Open client database, determine which account we're on
1.75 Find last 4 weeks and order range
5.3203125 Adding columns and formating
5.6171875 loop through last 4 weeks, add station clearance and P&L data to dictionary
5.6640625 find range of cumulative, add clearance and P&L for 2019
7.6171875 adding data from dictionary to order file

Anyway, below is the code...

Sub Orders_Historicals_autofilterdict()

Dim start As Double
start = Timer

''--------------------------------------
''Static Variables
''--------------------------------------
Call DefinedVariables

Dim orderFile As Variant
Dim orderStart As Long
Dim orderEnd As Long

Dim clientdataFile As Variant

Dim internalFile As Variant
Dim dateStart As Long
Dim stationStart As Long
Dim stationEnd As Long

Dim currentStation As String
Dim currentWeek As String

Dim dictData As New Scripting.Dictionary
Dim stationclearanceData As New Scripting.Dictionary
Dim stationplData As New Scripting.Dictionary

Dim key As Variant

Dim fileOnly As String
Dim networkOnly As String

Dim i As Long
Dim w As Long
Dim t As Long

Dim plTotal As Long
Dim clearTotal As Long
Dim stationHash As String

''--------------------------------------
''Dictionary the Order Abbreviations
''--------------------------------------
    Application.ScreenUpdating = False

    Set orderFile = ActiveWorkbook.ActiveSheet

        Workbooks.Open clientdataLocation

        Set clientdataFile = ActiveWorkbook.Sheets(dan_location) '/ Change sheet when using on different computer

        clientdataFile.Activate

            For i = 1 To Cells(Rows.count, 1).End(xlUp).row
                If dictData.Exists(Cells(i, clientOrder).Value) Then
                Else: dictData.Add Cells(i, clientOrder).Value, i
                End If
            Next

''--------------------------------------
''Determine Account/Network & Open Internal Associated with Order
''--------------------------------------
    orderFile.Activate

    fileOnly = ActiveWorkbook.Name

    fileOnly = Left(fileOnly, InStr(fileOnly, ".") - 1)

    If InStr(fileOnly, 2) > 0 Or InStr(fileOnly, 3) > 0 Then
        fileOnly = Left(fileOnly, Len(fileOnly) - 1)
    End If

    networkOnly = ActiveWorkbook.Name

    networkOnly = Mid(networkOnly, InStr(networkOnly, "IO.") + 3)

    networkOnly = Left(networkOnly, InStr(networkOnly, ".") - 1)

    Workbooks.Open Filename:=clientdataFile.Cells(dictData(fileOnly), clientInternal).Value

    Set internalFile = ActiveWorkbook

        internalFile.Sheets(WT_newWeek).Activate

Debug.Print Timer - start & " Open client database, determine which account we're on"
''--------------------------------------
''Find Last 4 Dates & Column Header for Orders
''--------------------------------------
        For i = 1 To 700
            If Cells(i, 1) = WT_newWeek Then
                dateStart = i
            ElseIf Cells(i, 1) = "Station" Then
                stationStart = i + 1
                Exit For
            End If
        Next

        For i = stationStart To 700
            If Cells(i, 1).Value = Cells(stationStart - 2, 1).Value & " Total" Then
                stationEnd = i - 1
                Exit For
            End If
        Next

    orderFile.Activate

        For i = 1 To 700
            If Cells(i, 1) = "Station" Then
                orderStart = i + 1
                Exit For
            End If
        Next

        For i = orderStart To 700
            If Len(Cells(i, 1)) = 0 And Len(Cells(i - 1, 1)) = 0 And Len(Cells(i - 2, 1)) = 0 Then
                orderEnd = i - 3
                Exit For
            End If
        Next


Debug.Print Timer - start & " Find last 4 weeks and order range"

''--------------------------------------
''Add Dates to Order Header and Formatting
''--------------------------------------

    Cells(orderStart - 1, OF_buyAlgoColumn) = "Algorithm Recommendation"
    Cells(orderStart - 1, OF_totalplColumn) = "Total P&L"
    Cells(orderStart - 1, OF_totalclearanceColumn) = "Total Clearance %"

    Cells(orderStart - 1, OF_clearanceColumn1) = internalFile.Sheets(WT_newWeek).Cells(dateStart, 1)
    Cells(orderStart - 1, OF_clearanceColumn2) = internalFile.Sheets(WT_newWeek).Cells(dateStart - 1, 1)
    Cells(orderStart - 1, OF_clearanceColumn3) = internalFile.Sheets(WT_newWeek).Cells(dateStart - 2, 1)
    Cells(orderStart - 1, OF_clearanceColumn4) = internalFile.Sheets(WT_newWeek).Cells(dateStart - 3, 1)

    Cells(orderStart - 1, OF_plColumn1) = internalFile.Sheets(WT_newWeek).Cells(dateStart, 1)
    Cells(orderStart - 1, OF_plColumn2) = internalFile.Sheets(WT_newWeek).Cells(dateStart - 1, 1)
    Cells(orderStart - 1, OF_plColumn3) = internalFile.Sheets(WT_newWeek).Cells(dateStart - 2, 1)
    Cells(orderStart - 1, OF_plColumn4) = internalFile.Sheets(WT_newWeek).Cells(dateStart - 3, 1)

    Range(Cells(orderStart - 2, OF_clearanceColumn1), Cells(orderStart - 2, OF_clearanceColumn4)) = "Clearance"
    Range(Cells(orderStart - 2, OF_plColumn1), Cells(orderStart - 2, OF_plColumn4)) = "P&L"

    Cells(orderStart - 1, OF_stationColumn).Copy
    Range(Cells(orderStart - 1, OF_buyAlgoColumn), Cells(orderStart - 1, OF_plColumn4)).PasteSpecial xlPasteFormats

    Cells(orderStart, OF_stationColumn).Copy
    Range(Cells(orderStart - 2, OF_clearanceColumn1), Cells(orderStart - 2, OF_plColumn4)).PasteSpecial xlPasteFormats

    Range(Cells(orderStart - 2, OF_buyAlgoColumn), Cells(orderEnd, OF_plColumn4)).HorizontalAlignment = xlCenter

    Cells(orderStart, OF_stationColumn).Copy
    Range(Cells(orderStart, OF_buyAlgoColumn), Cells(orderEnd, OF_plColumn4)).PasteSpecial xlPasteFormats

    Cells(orderStart, OF_totalColumn).Copy
    Range(Cells(orderStart, OF_plColumn1), Cells(orderEnd, OF_plColumn4)).PasteSpecial xlPasteFormats
    Range(Cells(orderStart, OF_totalplColumn), Cells(orderEnd, OF_totalplColumn)).PasteSpecial xlPasteFormats

    Range(Cells(orderStart, OF_totalclearanceColumn), Cells(orderEnd, OF_clearanceColumn4)).NumberFormat = "0%"

    Range(Cells(orderStart - 2, OF_buyAlgoColumn), Cells(orderEnd, OF_plColumn4)).FormatConditions.Delete

    Range(Columns(OF_buyAlgoColumn), Columns(OF_plColumn4)).AutoFit

Debug.Print Timer - start & " Adding columns and formating"

''--------------------------------------
''Add Clearance and P&L by Date to Dictionary
''--------------------------------------

    For i = OF_clearanceColumn1 To OF_clearanceColumn4

        currentWeek = Cells(orderStart - 1, i).Value

        internalFile.Sheets(currentWeek).Activate

            For t = 1 To 700

                If Cells(t, 1) = "Station" Then
                    stationStart = t + 1
                    Exit For
                End If
            Next

            For t = stationStart To 700

                If Cells(t, 1).Value = Cells(stationStart - 2, 1).Value & " Total" Then
                    stationEnd = i - 1
                    Exit For
                End If

                If stationclearanceData.Exists(Cells(t, WT_stationColumn).Value & currentWeek) Then
                Else:
                    On Error Resume Next
                    stationclearanceData.Add Cells(t, WT_stationColumn).Value & currentWeek, Cells(t, WT_mediaactColumn).Value / Cells(t, WT_mediaestColumn).Value
                    stationplData.Add Cells(t, WT_stationColumn).Value & currentWeek, Cells(t, WT_profitColumn).Value
                End If

            Next

        orderFile.Activate

    Next

Debug.Print Timer - start & " loop through last 4 weeks, add station clearance and P&L data to dictionary"

''--------------------------------------
''Add Cumulative Clearance and P&L to Dictionary
''--------------------------------------

    internalFile.Sheets("Cumulative").Activate

        For t = 5 To 70000

            If Cells(t, 1) = "" And Cells(t + 1, 1) = "" And Cells(t + 2, 1) = "" Then
                stationEnd = t + 1
                Exit For
            End If
        Next

        For t = 5 To stationEnd

            If Cells(t, CT_yearColumn) = 2019 Then

                If stationclearanceData.Exists(Cells(t, CT_hashColumn).Value) Then
                    Else:
                        On Error Resume Next
                        stationclearanceData.Add Cells(t, CT_hashColumn).Value, Cells(t, CT_clearanceColumn).Value
                        stationplData.Add Cells(t, CT_hashColumn).Value, Cells(t, CT_invoiceColumn).Value - Cells(t, CT_actcostColumn).Value
                End If
            End If
        Next

Debug.Print Timer - start & " find range of cumulative, add clearance and P&L for 2019"


    orderFile.Activate

''--------------------------------------
''Loop Through Stations on Order File and Update Based on Dictionary Values
''--------------------------------------

    For w = orderStart To orderEnd

        If Cells(w, OF_stationColumn) <> "" Then

            If Cells(w, OF_stationColumn) <> Cells(w - 1, OF_stationColumn) Then

                stationHash = Cells(w, OF_stationColumn).Value & " " & Cells(w, OF_trafficColumn).Value & " Total"

                On Error Resume Next
                Cells(w, OF_clearanceColumn1) = stationclearanceData(Cells(w, OF_stationColumn).Value & Cells(orderStart - 1, OF_clearanceColumn1).Value)
                Cells(w, OF_clearanceColumn2) = stationclearanceData(Cells(w, OF_stationColumn).Value & Cells(orderStart - 1, OF_clearanceColumn2).Value)
                Cells(w, OF_clearanceColumn3) = stationclearanceData(Cells(w, OF_stationColumn).Value & Cells(orderStart - 1, OF_clearanceColumn3).Value)
                Cells(w, OF_clearanceColumn4) = stationclearanceData(Cells(w, OF_stationColumn).Value & Cells(orderStart - 1, OF_clearanceColumn4).Value)

                Cells(w, OF_plColumn1) = stationplData(Cells(w, OF_stationColumn).Value & Cells(orderStart - 1, OF_plColumn1).Value)
                Cells(w, OF_plColumn2) = stationplData(Cells(w, OF_stationColumn).Value & Cells(orderStart - 1, OF_plColumn2).Value)
                Cells(w, OF_plColumn3) = stationplData(Cells(w, OF_stationColumn).Value & Cells(orderStart - 1, OF_plColumn3).Value)
                Cells(w, OF_plColumn4) = stationplData(Cells(w, OF_stationColumn).Value & Cells(orderStart - 1, OF_plColumn4).Value)

                Cells(w, OF_totalplColumn) = stationplData(stationHash)
                Cells(w, OF_totalclearanceColumn) = stationclearanceData(stationHash)

            End If

        End If

    Next

Debug.Print Timer - start & " adding data from dictionary to order file"

clientdataFile.Activate

    ActiveWorkbook.Close saveChanges:=False

Application.ScreenUpdating = True

Range(Cells(orderStart - 2, OF_buyAlgoColumn), Cells(orderEnd, OF_plColumn4)).HorizontalAlignment = xlCenter

MsgBox ("Buy Algorithm Complete")


End Sub

Answer 1

Obligatory message: Please ensure you use Option Explicit at the start of every module.

Code readability

The first thing that hits me is a wall of declarations. That and the double spacing makes it hard to review this code. Are all the variables used? I know that there are some variables in there that are not in that wall of declarations.

You are also happy to spread the lines out, but then use "scrunching" techniques such as Else: dictData.Add Cells(i, clientOrder).Value, i

Some of the code here can be broken into logic chunks - either as subroutines or functions. Remember, you can pass parameters to these routines!

DefinedVariables?

I don't know what DefinedVariables does.

Call is deprecated. You just use

DefinedVariables

instead of

Call DefinedVariables

Activethingies

You use the active workbook (explicitly and implicitly), active sheet (explicitly and implicitly) and active cell/range (implicitly) a lot. In reality, you can never be sure what is the active book, sheet or cell, you just don't know if something has changed the focus outside of your macro.

There are some occasions within Excel VBA where immediately grabbing the active object is necessary (e.g. when copying a sheet), but for pretty much all cases you can explicitly qualify the object you are using to prevent the code being hijacked by something that is on screen.

Having said that, activating something while screen updating is off is a null activity.

Object typing

You declare variables as Variant, but then use them for objects

Dim clientdataFile As Variant
Set clientdataFile = ActiveWorkbook.Sheets(dan_location) '/ Change sheet when using on different computer

If you are going to use it for worksheets, then declare it as such!

Dim clientdataFile As Worksheet

Strange use of inbuilt functions

InStr(fileOnly, 2) is not how InStr is supposed to be used. I suspect that this code does not work as intended - have you checked this?

Use Arrays instead of looping through cells

There have been numerous discussions in these hallowed halls about the performance hit of switching between the Excel Model and the VBA model. And every loop that calls a range or a cell performs that switch. The best option is to out the range into an array instead of looping.

The use of a do while loop is neater than an arbitrary For I = loop, the exit conditions are more explicitly stated than a hidden Exit For. Technically correct, but harder to maintain.

Use Excel functionality

Excel has named ranges. This can be exploited to simplify code. You don't have to declare static variables which hold column numbers if you can use the named ranges.

Magic numbers

You have some magic numbers in the code. What is the significance of 700 or 70000 ? How are you going to manage the code if these change - how will you ensure you have got every copy of them?

Also, what happens to stationStart or stationEnd if you go through the loops and do not find the relevant cell? Currently they stay at 0.

what does this look like? Putting most of what I said above into practice gives the following code. This is not tested and I have not moved all the declarations to where they are supposed to be. I have also found a couple left over!

Sub Orders_Historicals_autofilterdict2()

Dim start As Double
start = Timer

''--------------------------------------
''Static Variables
''--------------------------------------
DefinedVariables



Dim currentStation As String
Dim currentWeek As String

Dim stationclearanceData As New Scripting.Dictionary
Dim stationplData As New Scripting.Dictionary

Dim key As Variant

Dim i As Long
Dim w As Long

Dim plTotal As Long
Dim clearTotal As Long
Dim stationHash As String

''--------------------------------------
''Dictionary the Order Abbreviations
''--------------------------------------
    Application.ScreenUpdating = False

Dim orderFile As Worksheet ' notVariant
Dim clientdataFile As Worksheet 'Variant
Dim clientdataBook As Workbook ' I added this
Dim dictData As New Scripting.Dictionary

    Set orderFile = ActiveWorkbook.ActiveSheet ' consider putting that orderBook variable in, because this gets used a few times later.
    Set clientdataBook = Workbooks.Open(clientdataLocation)          'clientdataLocation is undeclared? What happens if this is null?
    Set clientdataFile = clientdataBook.Sheets(dan_location) '/ Change sheet when using on different computer
    With clientdataFile        ' not activate! Now the following code is fully qualified.
        For i = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
            If dictData.Exists(.Cells(i, clientOrder).Value) Then ' This could be "If Not dictData etc."
            Else
                dictData.Add .Cells(i, clientOrder).Value, i
            End If
        Next
    End With

''--------------------------------------
''Determine Account/Network & Open Internal Associated with Order
''--------------------------------------
Dim fileOnly As String
Dim networkOnly As String
Dim internalBook As Workbook ' I added this
    fileOnly = orderFile.Parent.Name ' no need to activate
    fileOnly = Left(fileOnly, InStr(fileOnly, ".") - 1)

    If InStr(fileOnly, 2) > 0 Or InStr(fileOnly, 3) > 0 Then '' Does this actually work?
        fileOnly = Left(fileOnly, Len(fileOnly) - 1)
    End If

    networkOnly = orderFile.Parent.Name ' at this point, you have already lost track of what is supposed to be active.
    networkOnly = Mid(networkOnly, InStr(networkOnly, "IO.") + 3)
    networkOnly = Left(networkOnly, InStr(networkOnly, ".") - 1)

Dim internalFile As Workbook
    Set internalFile = Workbooks.Open(Filename:=clientdataFile.Cells(dictData(fileOnly), clientInternal).Value)

Debug.Print Timer - start & " Open client database, determine which account we're on"
''--------------------------------------
''Find Last 4 Dates & Column Header for Orders
''--------------------------------------
Dim dateStart As Long
Dim stationStart As Long
Dim stationEnd As Long
Dim orderStart As Long
Dim orderEnd As Long
Dim findStationArray As Variant ' I added the next 4
Dim startFound As Boolean
Dim endFound As Boolean
Dim stationStartValue As String ' assumption here
    With internalFile.Sheets(WT_newWeek)   ' no need to Activate!
        findStationArray = .Range("A1:A700").Value
        i = LBound(findStationArray, 1)
        While i <= UBound(findStationArray, 1) Or Not startFound
            Select Case .Cells(i, 1).Value
                Case WT_newWeek
                    dateStart = i
                Case "Station"
                    If Not startFound Then
                        stationStart = i + 1
                        startFound = True
                    End If
            End Select
            i = i + 1
        Wend
        stationStartValue = .Cells(stationStart - 2, 1).Value & " Total" ' do this only once, not 700 times
        While i <= UBound(findStationArray, 1) Or Not endFound
            endFound = (.Cells(i, 1).Value = stationStartValue)
            If endFound Then stationEnd = i - 1
            i = i + 1
        Wend
    End With

    With orderFile ' again - do not .Activate
        findStationArray = .Range("A1:A700").Value
        i = LBound(findStationArray, 1)
        While i <= UBound(findStationArray, 1) Or Not startFound
            startFound = (.Cells(i, 1).Value = "Station")
            If startFound Then orderStart = i + 1
            i = i + 1
        Wend
        While i <= UBound(findStationArray, 1) Or Not endFound
            endFound = (Len(.Cells(i, 1)) = 0 And Len(.Cells(i - 1, 1)) = 0 And Len(.Cells(i - 2, 1)) = 0)
            If endFound Then orderEnd = i - 3
            i = i + 1
        Wend
    End With

Debug.Print Timer - start & " Find last 4 weeks and order range"

''--------------------------------------
''Add Dates to Order Header and Formatting
''--------------------------------------
    With orderFile ' assumption here - have we lost track of what is active yet?
        .Cells(orderStart - 1, OF_buyAlgoColumn) = "Algorithm Recommendation"
        .Cells(orderStart - 1, OF_totalplColumn) = "Total P&L"
        .Cells(orderStart - 1, OF_totalclearanceColumn) = "Total Clearance %"
        .Cells(orderStart - 1, OF_clearanceColumn1) = internalFile.Sheets(WT_newWeek).Cells(dateStart, 1)
        .Cells(orderStart - 1, OF_clearanceColumn2) = internalFile.Sheets(WT_newWeek).Cells(dateStart - 1, 1)
        .Cells(orderStart - 1, OF_clearanceColumn3) = internalFile.Sheets(WT_newWeek).Cells(dateStart - 2, 1)
        .Cells(orderStart - 1, OF_clearanceColumn4) = internalFile.Sheets(WT_newWeek).Cells(dateStart - 3, 1)
        .Cells(orderStart - 1, OF_plColumn1) = internalFile.Sheets(WT_newWeek).Cells(dateStart, 1)
        .Cells(orderStart - 1, OF_plColumn2) = internalFile.Sheets(WT_newWeek).Cells(dateStart - 1, 1)
        .Cells(orderStart - 1, OF_plColumn3) = internalFile.Sheets(WT_newWeek).Cells(dateStart - 2, 1)
        .Cells(orderStart - 1, OF_plColumn4) = internalFile.Sheets(WT_newWeek).Cells(dateStart - 3, 1)
        .Range(.Cells(orderStart - 2, OF_clearanceColumn1), .Cells(orderStart - 2, OF_clearanceColumn4)) = "Clearance"
        .Range(.Cells(orderStart - 2, OF_plColumn1), .Cells(orderStart - 2, OF_plColumn4)) = "P&L"
        .Cells(orderStart - 1, OF_stationColumn).Copy
        .Range(.Cells(orderStart - 1, OF_buyAlgoColumn), .Cells(orderStart - 1, OF_plColumn4)).PasteSpecial xlPasteFormats
        .Cells(orderStart, OF_stationColumn).Copy
        .Range(.Cells(orderStart - 2, OF_clearanceColumn1), .Cells(orderStart - 2, OF_plColumn4)).PasteSpecial xlPasteFormats
        .Range(.Cells(orderStart - 2, OF_buyAlgoColumn), .Cells(orderEnd, OF_plColumn4)).HorizontalAlignment = xlCenter
        .Cells(orderStart, OF_stationColumn).Copy
        .Range(.Cells(orderStart, OF_buyAlgoColumn), .Cells(orderEnd, OF_plColumn4)).PasteSpecial xlPasteFormats
        .Cells(orderStart, OF_totalColumn).Copy
        .Range(.Cells(orderStart, OF_plColumn1), .Cells(orderEnd, OF_plColumn4)).PasteSpecial xlPasteFormats
        .Range(.Cells(orderStart, OF_totalplColumn), .Cells(orderEnd, OF_totalplColumn)).PasteSpecial xlPasteFormats
        .Range(.Cells(orderStart, OF_totalclearanceColumn), .Cells(orderEnd, OF_clearanceColumn4)).NumberFormat = "0%"
        .Range(.Cells(orderStart - 2, OF_buyAlgoColumn), .Cells(orderEnd, OF_plColumn4)).FormatConditions.Delete
        .Range(.Columns(OF_buyAlgoColumn), .Columns(OF_plColumn4)).AutoFit
    End With
Debug.Print Timer - start & " Adding columns and formating"

''--------------------------------------
''Add Clearance and P&L by Date to Dictionary
''--------------------------------------

Dim t As Long
    For i = OF_clearanceColumn1 To OF_clearanceColumn4
        currentWeek = orderFile.Cells(orderStart - 1, i).Value
        With internalFile.Sheets(currentWeek)
            findStationArray = .Range("A1:A700").Value
            t = LBound(findStationArray, 1)
            While t <= UBound(findStationArray, 1) Or Not startFound
                startFound = (.Cells(t, 1).Value = "Station")
                If startFound Then stationStart = t + 1
                t = t + 1
            Wend
            stationStartValue = .Cells(stationStart - 2, 1).Value & " Total" ' do this only once, not 700 times
            While t <= UBound(findStationArray, 1) Or Not endFound
                endFound = (.Cells(t, 1).Value = stationStartValue)
                If endFound Then
                    stationEnd = i - 1 ' is this meant to be "i" or "t" ?
                Else
                    If stationclearanceData.Exists(Cells(t, WT_stationColumn).Value & currentWeek) Then
                    Else
                        On Error Resume Next ' I assume you want to fail silently. Otherwise this is dangerous
                        stationclearanceData.Add Cells(t, WT_stationColumn).Value & currentWeek, Cells(t, WT_mediaactColumn).Value / Cells(t, WT_mediaestColumn).Value
                        stationplData.Add Cells(t, WT_stationColumn).Value & currentWeek, Cells(t, WT_profitColumn).Value
                        On Error GoTo 0 ' stop the error hiding - otherwise you will not pick up any errors later in the code
                    End If
                End If
                i = i + 1
            Wend
        End With
    Next i

Debug.Print Timer - start & " loop through last 4 weeks, add station clearance and P&L data to dictionary"

''--------------------------------------
''Add Cumulative Clearance and P&L to Dictionary
''--------------------------------------
Dim cumulativeSheet As Worksheet
    With internalFile.Sheets("Cumulative") ' again, no need to .Activate
        findStationArray = .Range("A5:A70000").Value
        t = LBound(findStationArray, 1)
        While t <= UBound(findStationArray, 1) Or Not endFound
            endFound = (.Cells(t, 1) = "" And .Cells(t + 1, 1) = "" And .Cells(t + 2, 1) = "")
            ' If endFound Then stationEnd = t + 1 ' this is superfluous, because the loop will exit with t+1 anyway. But good to have here for future readability and maintenance.
            t = t + 1
        Wend

        For t = 5 To stationEnd
            If Cells(t, CT_yearColumn) = 2019 Then
                If stationclearanceData.Exists(Cells(t, CT_hashColumn).Value) Then
                Else
                    On Error Resume Next
                    stationclearanceData.Add Cells(t, CT_hashColumn).Value, Cells(t, CT_clearanceColumn).Value
                    stationplData.Add Cells(t, CT_hashColumn).Value, Cells(t, CT_invoiceColumn).Value - Cells(t, CT_actcostColumn).Value
                    On Error GoTo 0 ' stop the error hiding - otherwise you will not pick up any errors later in the code
                End If
            End If
        Next

Debug.Print Timer - start & " find range of cumulative, add clearance and P&L for 2019"

''--------------------------------------
''Loop Through Stations on Order File and Update Based on Dictionary Values
''--------------------------------------
' **** The changes here are for better performance.
Dim stationValues As Variant
Dim trafficValues As Variant
Dim totalPLValues As Variant
Dim totalClearanceValues As Variant
Dim clearance1Values As Variant ' if these are contiguous columns then this could be handled as a two dimensional array.
Dim clearance2Values As Variant
Dim clearance3Values As Variant
Dim clearance4Values As Variant
Dim pl1Values As Variant ' Ditto
Dim pl2Values As Variant
Dim pl3Values As Variant
Dim pl4Values As Variant
Dim clearanceValue1 As String
Dim clearanceValue2 As String
Dim clearanceValue3 As String
Dim clearanceValue4 As String
Dim plValue1 As String
Dim plValue2 As String
Dim plValue3 As String
Dim plValue4 As String

    With orderFile '.Activate
        stationValues = .Range(.Cells(orderStart - 1, OF_stationColumn), .Cells(orderEnd, OF_stationColumn)).Value ' use arrays instead of calling excel ranges
        trafficValues = .Range(.Cells(orderStart - 1, OF_trafficColumn), .Cells(orderEnd, OF_trafficColumn)).Value ' use arrays instead of calling excel ranges
        totalPLValues = .Range(.Cells(orderStart - 1, OF_totalplColumn), .Cells(orderEnd, OF_totalplColumn)).Value
        totalClearanceValues = .Range(.Cells(orderStart - 1, OF_totalclearanceColumn), .Cells(orderEnd, OF_totalclearanceColumn)).Value
        clearance1Values = .Range(.Cells(orderStart - 1, OF_clearanceColumn1), .Cells(orderEnd, OF_clearanceColumn1)).Value
        clearance2Values = .Range(.Cells(orderStart - 1, OF_clearanceColumn2), .Cells(orderEnd, OF_clearanceColumn2)).Value
        clearance3Values = .Range(.Cells(orderStart - 1, OF_clearanceColumn3), .Cells(orderEnd, OF_clearanceColumn3)).Value
        clearance4Values = .Range(.Cells(orderStart - 1, OF_clearanceColumn4), .Cells(orderEnd, OF_clearanceColumn4)).Value
        pl1Values = .Range(.Cells(orderStart - 1, OF_plColumn1), .Cells(orderEnd, OF_plColumn1)).Value
        pl2Values = .Range(.Cells(orderStart - 1, OF_plColumn2), .Cells(orderEnd, OF_plColumn2)).Value
        pl3Values = .Range(.Cells(orderStart - 1, OF_plColumn3), .Cells(orderEnd, OF_plColumn3)).Value
        pl4Values = .Range(.Cells(orderStart - 1, OF_plColumn4), .Cells(orderEnd, OF_plColumn4)).Value
        clearanceValue1 = .Cells(orderStart - 1, OF_clearanceColumn1).Value ' evaluate these only once, instead of every time in the loop
        clearanceValue2 = .Cells(orderStart - 1, OF_clearanceColumn2).Value
        clearanceValue3 = .Cells(orderStart - 1, OF_clearanceColumn3).Value
        clearanceValue4 = .Cells(orderStart - 1, OF_clearanceColumn4).Value
        plValue1 = .Cells(orderStart - 1, OF_plColumn1).Value
        plValue2 = .Cells(orderStart - 1, OF_plColumn2).Value
        plValue3 = .Cells(orderStart - 1, OF_plColumn3).Value
        plValue4 = .Cells(orderStart - 1, OF_plColumn4).Value
        For w = LBound(stationValues) + 1 To UBound(stationValues) 'orderStart To orderEnd
            If stationValues(w, 1) <> "" Then
                If stationValues(w, 1) <> stationValues(w - 1, 1) Then
                    stationHash = stationValues(w, 1) & " " & stationValues(w, 1) & " Total"
                    ' On Error Resume Next ' don't hide errors - what is the issue here?
                    clearance1Values(w, 1) = stationclearanceData(stationValues(w, 1) & clearanceValue1)
                    clearance2Values(w, 1) = stationclearanceData(stationValues(w, 1) & clearanceValue2)
                    clearance3Values(w, 1) = stationclearanceData(stationValues(w, 1) & clearanceValue3)
                    clearance4Values(w, 1) = stationclearanceData(stationValues(w, 1) & clearanceValue4)

                    pl1Values(w, 1) = stationclearanceData(stationValues(w, 1) & plValue1)
                    pl1Values(w, 2) = stationclearanceData(stationValues(w, 1) & plValue2)
                    pl1Values(w, 3) = stationclearanceData(stationValues(w, 1) & plValue3)
                    pl1Values(w, 4) = stationclearanceData(stationValues(w, 1) & plValue4)

                    totalPLValues(w, 1) = stationplData(stationHash)
                    totalClearanceValues(w, 1) = stationclearanceData(stationHash)
                End If
            End If
        Next
        ' return the changed arrays to the ranges.
        .Range(.Cells(orderStart - 1, OF_totalplColumn), .Cells(orderEnd, OF_totalplColumn)).Value = totalPLValues
        .Range(.Cells(orderStart - 1, OF_totalclearanceColumn), .Cells(orderEnd, OF_totalclearanceColumn)).Value = totalClearanceValues
        .Range(.Cells(orderStart - 1, OF_clearanceColumn1), .Cells(orderEnd, OF_clearanceColumn1)).Value = clearance1Values
        .Range(.Cells(orderStart - 1, OF_clearanceColumn2), .Cells(orderEnd, OF_clearanceColumn2)).Value = clearance2Values
        .Range(.Cells(orderStart - 1, OF_clearanceColumn3), .Cells(orderEnd, OF_clearanceColumn3)).Value = clearance3Values
        .Range(.Cells(orderStart - 1, OF_clearanceColumn4), .Cells(orderEnd, OF_clearanceColumn4)).Value = clearance4Values
        .Range(.Cells(orderStart - 1, OF_plColumn1), .Cells(orderEnd, OF_plColumn1)).Value = pl1Values
        .Range(.Cells(orderStart - 1, OF_plColumn2), .Cells(orderEnd, OF_plColumn2)).Value = pl2Values
        .Range(.Cells(orderStart - 1, OF_plColumn3), .Cells(orderEnd, OF_plColumn3)).Value = pl3Values
        .Range(.Cells(orderStart - 1, OF_plColumn4), .Cells(orderEnd, OF_plColumn4)).Value = pl4Values
    End With

Debug.Print Timer - start & " adding data from dictionary to order file"

    clientdataBook.Close saveChanges:=False
    Application.ScreenUpdating = True

    ' lost track of what is supposed to be active yet?
    orderFile.Range(Cells(orderStart - 2, OF_buyAlgoColumn), Cells(orderEnd, OF_plColumn4)).HorizontalAlignment = xlCenter

    MsgBox ("Buy Algorithm Complete")
End Sub