Using dictionary to reduce run-time VBA

Question

Following from a question I asked yesterday in regards to optimizing VLookups, I'm trying to create a quick way of returning associated values across 2 workbooks based on Account Number, returning the Days Past Due Value. Here's an example of the Excel columns I'm working with:

MonthlyRepTool: Account Number | .. | .. | Days Past Dec

DailyShout3: Account Number | .. | Days Past Due

I've started using the dictionary function which I thought would reduce run-time as it previously took 12 minutes to run this VLookup but it still takes 10 minutes to fully run and it does not seem to return values to any column - DPD End Dec. It appears it's running and calculating but don't know where the results are going. I'm still pretty new to 'Dictionary' so haven't the best eye for catching errors.

Note: these files have variable names and column numbers, hence why I've added code to find column headers and specific files. This file represents the 2 month old file.

Sub testDPDEnd()

    'Declaring ranges for columns with specific column headers
   Dim a As Range
   Dim b As Range
   Dim c As Range
   Dim d As Range
   
   Dim accountNumbers As New Scripting.Dictionary
   Dim DailyShout3 As Workbook
   Dim MonthlyRepTool As Workbook
   Dim myFile As String
   Dim otherFile As String
   Dim AccDailySColumnNumber As Long
   Dim DPDDailySColumnNumber As Long
   Dim AccMonthlyColumnNumber As Long
   Dim DPDMonthlyColumnNumber As Long
   Dim wb As Workbook
   Dim sheet As String
   
   Dim lastRow As Long
    Dim thisRow As Long
    
    'Declaring year of 2 month Daily Shout file
    Dim Year_2M As Integer

    'Declaring location of 2 month Daily Shout file
    Dim Month_2M As String

    'Declaring location of 2 month Daily Shout file
    Dim MonthChar_2 As String

    'Declaring year value of 1 month & 2 month
    'This is important to compare datasets from 2 months ago & last month
    Year_2M = Format(Date - 57, "YYYY")

    'Declaring month value of 1 month & 2 month
    'This is important to compare datasets from 2 months ago & last month
    Month_2M = Format(Date - 57, "MM")

    'This translates the current month from number to character format
    MonthChar_2 = MonthName(Month_2M, False)
   
   'declaring these as strings to identify the book that's open
   myFile = "Daily Shout"
   otherFile = "Monthly Reporting Tool"
   
   'identifying the MOnthlyRepTool sheet
   sheet = "MASTERFILE_" & Year_2M & Month_2M
   
    'checking to see that the reporting tool is open, declaring it as MonthlyRepTool
    For Each wb In Application.Workbooks
        If wb.Name Like "*" & myFile & "*" Then
           Set DailyShout3 = Workbooks(wb.Name)
        End If
    Next wb
    
    'checking to see that the reporting tool is open, declaring it as MonthlyRepTool
    For Each wb In Application.Workbooks
        If wb.Name Like otherFile & "*" Then
           Set MonthlyRepTool = Workbooks(wb.Name)
        End If
    Next wb
    
   'Finding account number and declaring that column as range a
   With DailyShout3.Worksheets(1).Rows(1)
    Set a = .Find("Account Number", LookIn:=xlValues)
        AccDailySColumnNumber = a.Column
    End With
    
    'Finding Account number and declaring that column as range c
    With MonthlyRepTool.Worksheets(sheet).Rows(1)
    Set c = .Find("Account Number", LookIn:=xlValues)
        AccMonthlyColumnNumber = c.Column
    End With
    
    'Finding DPD End Dec and declaring that column as range d
    With MonthlyRepTool.Worksheets(sheet).Rows(1)
    Set d = .Find("DPD End Dec", LookIn:=xlValues)
        DPDMonthlyColumnNumber = d.Column
    End With

    'Finding Days Past Due and declaring that column as range b
    With DailyShout3.Worksheets(1).Rows(1)
    Set b = .Find("Days Past Due", LookIn:=xlValues)
        DPDDailySColumnNumber = b.Column
    End With
    
    'adding account numbers in daily shout file to dictionary
    With DailyShout3.Worksheets(1)
    lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    For thisRow = 2 To lastRow
        accountNumbers.Add .Cells(thisRow, AccDailySColumnNumber).value, _
        .Cells(thisRow, DPDDailySColumnNumber).value
    Next thisRow
    End With
    
    'looks for dictionary value in MonthlyRepTool and returns the corresponding value
    'in DPD column
    With MonthlyRepTool.Worksheets(sheet)
    lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    For thisRow = 2 To lastRow
        If accountNumbers.Exists(.Cells(thisRow, AccMonthlyColumnNumber).value) Then
            .Cells(thisRow, DPDMonthlyColumnNumber).value = _
            accountNumbers.Item(.Cells(thisRow, DPDDailySColumnNumber).value)
        Else
            .Cells(thisRow, DPDMonthlyColumnNumber).value = "#Not Found#"
        End If
    Next thisRow
    End With
    
   
End Sub

Answer 1

You have the dictionary part, but you're missing the array part, so you're still reading from/writing to the sheet cell-by-cell, and that's very slow for that much data.

Try something more like this (untested):

Dim arrAcct, arrData, r As Long
'...
'...
'adding account numbers in daily shout file to dictionary
With DailyShout3.Worksheets(1)
    lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
    'read all data into arrays
    arrAcct = .Range(.Cells(2, AccDailySColumnNumber), _
                     .Cells(lastrow, AccDailySColumnNumber)).Value
    arrData = .Range(.Cells(2, DPDDailySColumnNumber), _
                     .Cells(lastrow, DPDDailySColumnNumber)).Value
    'fill the dictionary from the arrays
    For r = 1 To UBound(arrAcct, 1)
        accountNumbers.Add arrAcct(r, 1), arrData(r, 1)
    Next r
End With

'looks for dictionary value in MonthlyRepTool and returns the corresponding value
'in DPD column
With MonthlyRepTool.Worksheets(Sheet)
    lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
    'read all data into arrays
    arrAcct = .Range(.Cells(2, AccMonthlyColumnNumber), _
                     .Cells(lastrow, AccMonthlyColumnNumber)).Value
    arrData = .Range(.Cells(2, DPDMonthlyColumnNumber), _
                     .Cells(lastrow, DPDMonthlyColumnNumber)).Value
    'populate arrData from the dictionary
    For r = 1 To UBound(arrAcct, 1)
        If accountNumbers.Exists(arrAcct(r, 1)) Then
            arrData(r, 1) = accountNumbers(arrAcct(r, 1))
        Else
            arrData(r, 1) = "#Not Found#"
        End If
    Next r
    'put the populated array back on the sheet
    .Range(.Cells(2, DPDMonthlyColumnNumber), _
           .Cells(lastrow,  DPDMonthlyColumnNumber)).Value = arrData
End With

FYI that method does a lot, and some of that would benefit from being factored out into separate functions like (eg) GetWorkbook(wbName) or GetColumnIndex(Header). Your main method would then be shorter and more-focussed.