patternMinor
VBA lookup to complete matrix
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 SubSolution
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:
Thanks to @MacroMarc, I've updated the errors in my code (which was all done off the top of my head).
Several comments then, illustrated in the example code below:
- Good declarations for your separate
Worksheetvariables; 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
ovRowsanddataRows. 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
Constmakes 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 SubCode 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 SubContext
StackExchange Code Review Q#144814, answer score: 4
Revisions (0)
No revisions yet.