HiveBrain v1.2.0
Get Started
← Back to all entries
patternMinor

VBA lookup to complete matrix

Submitted by: @import:stackexchange-codereview··
0
Viewed 0 times
lookupcompletematrixvba

Problem

I have written the following the code to complete a matrix based on data provided in a second worksheet, but the code is really slow (note that s1=12,000, s2=40 and s3 = 200,000). Any suggestions on how to make this code faster?

Sub UpdateMatrix()

Dim wsOverview As Worksheet, wsData As Worksheet
Dim rngTable As Range
Dim varAccount As Variant, varData As Variant
Dim i As Long, t As Long

Set wsOverview = ThisWorkbook.Worksheets(1)
Set wsData = ThisWorkbook.Worksheets(2)

Set rngTable = wsOverview.Range("A:A")
i = Application.WorksheetFunction.CountA(rngTable) + 1

Set rngTable = wsData.Range("A:A")
t = Application.WorksheetFunction.CountA(rngTable)

For s1 = 2 To i
varAccount = wsOverview.Range("A" & s1).Value

For s2 = 1 To 37
varData = wsOverview.Range("A1").Offset(0, s2).Value

For s3 = 2 To t

    If varAccount = wsData.Range("B" & s3).Value And varData = wsData.Range("A" & s3).Value Then

    wsOverview.Range("A" & s1).Offset(0, s2).Value = wsData.Range("F" & s3).Value

    Exit For

    End If

Next s3

Next s2

Next s1

End Sub

Solution

I'm seeing several good practices in your code, you have a solid foundation to build upon. There are a few things to point out, but to answer your basic performance question -- process all your data in memory arrays. You'll see a tremendous performance improvement.

Several comments then, illustrated in the example code below:

  • Good declarations for your separate Worksheet variables; they are nicely descriptive.



  • Single-letter variables are not very descriptive (though a common practice is to restrict use of single-letter variables as loop indexes). So my suggestion is to rename these to ovRows and dataRows. These hold the number of rows detected on each sheet, so the variable name should echo that usage.



  • Use constants declared for fixed values. From what I can tell in your code, you have a limit to the number of columns on both sheets. Assuming this is a hard-coded value, declaring these as Const makes it easier to understand (and to change later if necessary).



  • Pull the overview and data ranges into local (memory-based) arrays for processing. This is the setup for the real speed.



  • Modify the loop to use the memory arrays. The example below is all-array, all the time. (If I've correctly understood your rows/columns logic.)



  • When the processing is completed, "write" the updated data back to the worksheet.



Thanks to @MacroMarc, I've updated the errors in my code (which was all done off the top of my head).

Option Explicit

Sub UpdateMatrix()
    Dim wsOverview As Worksheet, wsData As Worksheet
    Dim rngTable As Range

    Set wsOverview = ThisWorkbook.Worksheets("Sheet1")
    Set wsData = ThisWorkbook.Worksheets("Sheet2")

    Dim ovRows As Long
    Set rngTable = wsOverview.Range("A:A")
    ovRows = Application.WorksheetFunction.CountA(rngTable) + 1

    Dim dataRows As Long
    Set rngTable = wsData.Range("A:A")
    dataRows = Application.WorksheetFunction.CountA(rngTable)

    '--- set up memory based arrays
    Dim overviewRange as Range
    Dim overview As Variant
    Const OV_COL_LIMIT = 37
    set overviewRange = wsOverview.Range("A1").Resize(ovRows, COL_LIMIT)
    overview = overviewRange

    Dim dataRange As Range
    Dim data As Variant
    Const DATA_COL_LIMIT = 6
    set dataRange = wsData.Range("A1").Resize(dataRows, DATA_COL_LIMIT)
    data = dataRange

    Dim varAccount As Variant, varData As Variant
    Dim dataAcct As Variant, dataData As Variant
    For s1 = 2 To 3
        varAccount = overview(s1, 1)
        For s2 = 1 To COL_LIMIT
            varData = overview(1, s2)
            For s3 = 2 To dataRows
                dataAcct = data(s3, 2)
                dataData = data(s3, 1)
                If (varAccount = datraacct) And (varData = dataData) Then
                    overview(s1, 1) = data(s3, 6)
                    Exit For
                End If
            Next s3
        Next s2
    Next s1

    '--- put the data array back on the sheet
    overviewRange = overview
End Sub

Code Snippets

Option Explicit

Sub UpdateMatrix()
    Dim wsOverview As Worksheet, wsData As Worksheet
    Dim rngTable As Range

    Set wsOverview = ThisWorkbook.Worksheets("Sheet1")
    Set wsData = ThisWorkbook.Worksheets("Sheet2")

    Dim ovRows As Long
    Set rngTable = wsOverview.Range("A:A")
    ovRows = Application.WorksheetFunction.CountA(rngTable) + 1

    Dim dataRows As Long
    Set rngTable = wsData.Range("A:A")
    dataRows = Application.WorksheetFunction.CountA(rngTable)

    '--- set up memory based arrays
    Dim overviewRange as Range
    Dim overview As Variant
    Const OV_COL_LIMIT = 37
    set overviewRange = wsOverview.Range("A1").Resize(ovRows, COL_LIMIT)
    overview = overviewRange

    Dim dataRange As Range
    Dim data As Variant
    Const DATA_COL_LIMIT = 6
    set dataRange = wsData.Range("A1").Resize(dataRows, DATA_COL_LIMIT)
    data = dataRange

    Dim varAccount As Variant, varData As Variant
    Dim dataAcct As Variant, dataData As Variant
    For s1 = 2 To 3
        varAccount = overview(s1, 1)
        For s2 = 1 To COL_LIMIT
            varData = overview(1, s2)
            For s3 = 2 To dataRows
                dataAcct = data(s3, 2)
                dataData = data(s3, 1)
                If (varAccount = datraacct) And (varData = dataData) Then
                    overview(s1, 1) = data(s3, 6)
                    Exit For
                End If
            Next s3
        Next s2
    Next s1

    '--- put the data array back on the sheet
    overviewRange = overview
End Sub

Context

StackExchange Code Review Q#144814, answer score: 4

Revisions (0)

No revisions yet.