I created this simple macro that works fine for its purpose: allow the user to create a list of updates that need to be made based on groups in a target table (to basically do mass updates).

However, I am very concerned about the performance of this macro, it would take less time to do it manually if the list of updates becomes significantly long. I started optimizing the code using arrays but that seems not be enough.

What I am going to look into next is the use of dictionaries, is anyone aware of the most optimal way to achieve this?

Sub UpdateManualUpdates()
Application.ScreenUpdating = False
Dim lookUpSheet As Worksheet, updateSheet As Worksheet
Dim valueToSearch As String
Dim i As Long, t As Long
Set lookUpSheet = Worksheets("Manual price changes")
Set updateSheet = Worksheets("Price Build-up")
Dim lookUpSheetArray As Variant
Dim updateSheetArray As Variant
lastRowLookup = lookUpSheet.Cells(Rows.Count, "F").End(xlUp).Row
lastRowUpdate = updateSheet.Cells(Rows.Count, "B").End(xlUp).Row
lookUpSheetArray = lookUpSheet.Range("A1:F" & lastRowLookup).Value
updateSheetArray = updateSheet.Range("A1:AW" & lastRowUpdate).Value
For i = 6 To lastRowLookup 'i = 2 to last to omit the first row as that row is for headers
valueType = lookUpSheetArray(i, 5) 'lookUpSheet.Cells(i, 5) 'Type of update - Both, Planning group or GC
valueGroup = lookUpSheetArray(i, 3) 'Family group
valueGC = lookUpSheetArray(i, 4) 'GC
ValueChange = lookUpSheetArray(i, 6) 'What is the % change
'above get the values from the four column into variables
For t = 6 To lastRowUpdate
'AW is column 49 target column to update
'M is target column for group, 13
'C is target column for GC, 3
If valueType = "Both" Then
If updateSheetArray(t, 13) = valueGroup And updateSheetArray(t, 3) = valueGC Then
updateSheet.Cells(t, 49) = ValueChange
End If
End If
If valueType = "Planning group" Then
If updateSheetArray(t, 13) = valueGroup Then
updateSheet.Cells(t, 49) = ValueChange
End If
End If
If valueType = "GC" Then
If updateSheetArray(t, 3) = valueGC Then
updateSheet.Cells(t, 49) = ValueChange
End If
End If
Next t
Next i
Application.ScreenUpdating = True
End Sub

1 Answer
1

It looks like you'll have to set up three dictionaries that reference the same data. In your case, the dictionaries are based on your TARGET data that should change: updateSheetArray. You need three dictionaries because you want to access the data three different ways. The trick is in choosing a unique value from the data to be used as the key into the data. The first two values are simple, single column values: PlanningGroup and GC.

Since one of your choices is "Both", you have to create a key from the data that combines both of those fields into a single value. This can be done on the worksheet itself in the form of a visible or hidden column (and thus also pulled into a memory array), or you can combine the fields in your VBA code. My preferred method for this is to combine the two (or more) fields into a single string in the code, though each situation is different. You can do a simple concatenate or concatenate with a delimiter, it does't matter.

Before we get to the dictionary part of the answer, I will suggest a few items in the code review part of this answer.

Always use Option Explicit. You might be doing this, but it's good to make sure it's visible in your questions (or answers) so it doesn't come up like this.

Declare your variables as close as possible to the first use of the variable. It saves lots of back and forth searching for declarations, plus your code is now a little grouped into "logic blocks".

Define constants for "magic numbers". These are typically a straight numerical value you've hard-coded into your routines. Any other developer that comes along will have to scratch their head to figure out why you're starting a loop from index 6. You also might need to use the same value in multiple places, so creating a Const once isolates the definition and then you only have to change it once.

I've made these constants Private at the global module level, but they easily could be restricted in scope to the single Sub in the code. (The example Sub below is a bit long and I could have separated it into smaller functions, I'll leave that as an exercise for the reader :) ).

One problem I noticed in your code is when you're calculating the last row. Your statement is good but you've missed a worksheet reference when using Rows.Count. Since the Rows is not qualified with a worksheet reference, it is counting the rows on the currently active sheet. My habit is to wrap the statement in a With block, just to make sure I have to correct reference:

You are copying data from the worksheet Range into a memory-based array, and that will give you a much faster execution. The bonus is that you're not interacting with the screen, so Application.ScreenUpdating = False is not necessary. (You'll see another change to support this below)

Now comes the Dictionary build up. We're working with your target data, which is the sheet that needs to be updated. You want to be able to find any row in your data with a single reference. I'm assuming the data on your updateSheet could be hundreds or thousands of lines long. Notice in the loop below that I'm creating three dictionaries, including using a combination key to pick up the option to reference entries for "both".

Also, I figured that there could be more than one row in the data that may match the update criteria. So the dictionary keeps track by building a (string) list of row numbers to use later.

Now that we have the dictionaries complete, we only need a single pass through the lookUpSheet data. We'll get the list of rows from the selected dictionary, then update only those rows in the memory-based array NOT directly on the worksheet. So this inside loop is restricted to ONLY the rows needing updated values. This is where you get your other burst of speed.

Dim valueGroup As String
Dim valueGC As String
Dim valueType As String
Dim valueChange As Double
Dim updateRows As Variant
For i = START_OF_LOOKUP_DATA To UBound(lookUpSheetArray, 1)
valueType = lookUpSheetArray(i, LOOKUP_TYPE_COL)
valueGroup = lookUpSheetArray(i, LOOKUP_GROUP_COL)
valueGC = lookUpSheetArray(i, LOOKUP_GC_COL)
bothKey = valueGroup & valueGC
valueChange = lookUpSheetArray(i, LOOKUP_CHANGE_COL)
updateRows = -1 'reset to a non-array value
Select Case valueType
Case "Planning group"
If groupKeys.Exists(valueGroup) Then
updateRows = Split(groupKeys(valueGroup), ",")
End If
Case "GC"
If gcKeys.Exists(valueGC) Then
updateRows = Split(gcKeys(valueGC), ",")
End If
Case "Both"
If bothKeys.Exists(bothKey) Then
updateRows = Split(bothKeys(bothKey), ",")
End If
End Select
'--- update the values if we found the rows to update
If IsArray(updateRows) Then
Dim j As Long
For j = LBound(updateRows, 1) To UBound(updateRows, 1)
updateSheetArray(CLng(updateRows(j)), UPDATE_CHANGE_COL) = valueChange
Next j
End If
Next i

The final step is to copy the modified memory array back to the worksheet (which is why I created the updateSheetRange variable earlier).

updateSheetRange.value = updateSheetArray

Here is the whole solution in a single module:

Option Explicit
Private Const LOOKUP_TYPE_COL As Long = 5
Private Const LOOKUP_GROUP_COL As Long = 3
Private Const LOOKUP_GC_COL As Long = 4
Private Const LOOKUP_CHANGE_COL As Long = 6
Private Const UPDATE_GROUP_COL As Long = 13
Private Const UPDATE_GC_COL As Long = 3
Private Const UPDATE_CHANGE_COL As Long = 49
Private Const START_OF_LOOKUP_DATA As Long = 2
Private Const START_OF_UPDATE_DATA As Long = 6
Sub UpdateManualUpdates()
Dim lookUpSheet As Worksheet
Dim lastRowLookup As Long
Dim lookUpSheetRange As Range
Dim lookUpSheetArray As Variant
Set lookUpSheet = Worksheets("Manual price changes")
With lookUpSheet
lastRowLookup = .Cells(.Rows.Count, "F").End(xlUp).Row
Set lookUpSheetRange = .Range("A1").Resize(lastRowLookup, 6)
lookUpSheetArray = lookUpSheetRange.value
End With
Dim updateSheet As Worksheet
Dim lastRowUpdate As Long
Dim updateSheetRange As Range
Dim updateSheetArray As Variant
Set updateSheet = Worksheets("Price Build-up")
With updateSheet
lastRowUpdate = .Cells(.Rows.Count, "B").End(xlUp).Row
Set updateSheetRange = .Range("A1").Resize(lastRowUpdate, 49)
updateSheetArray = updateSheetRange.value
End With
'--- build up the dictionaries for the UPDATE array where the keys
' are single or multiple fields and the entry is CSV list of
' row numbers that match the given key
Dim groupKeys As Dictionary
Dim gcKeys As Dictionary
Dim bothKeys As Dictionary
Set groupKeys = New Dictionary
Set gcKeys = New Dictionary
Set bothKeys = New Dictionary
Dim updateGroup As String
Dim updateGC As String
Dim bothKey As String
Dim existingList As String
Dim i As Long
For i = START_OF_UPDATE_DATA To UBound(updateSheetArray, 1)
updateGroup = updateSheetArray(i, UPDATE_GROUP_COL)
updateGC = updateSheetArray(i, UPDATE_GC_COL)
If Not groupKeys.Exists(updateGroup) Then
groupKeys.Add updateGroup, CStr(i)
Else
existingList = groupKeys(updateGroup)
groupKeys(updateGroup) = existingList & "," & CStr(i)
End If
If Not gcKeys.Exists(updateGC) Then
gcKeys.Add updateGC, CStr(i)
Else
existingList = gcKeys(updateGC)
gcKeys(updateGC) = existingList & "," & CStr(i)
End If
bothKey = updateGroup & updateGC
If Not bothKeys.Exists(bothKey) Then
bothKeys.Add bothKey, CStr(i)
Else
existingList = bothKeys(bothKey)
bothKeys(bothKey) = existingList & "," & CStr(i)
End If
Next i
'--- now compare each row of the lookup data to find it in the update
' data and make the appropriate change to the memory array
Dim valueGroup As String
Dim valueGC As String
Dim valueType As String
Dim valueChange As Double
Dim updateRows As Variant
For i = START_OF_LOOKUP_DATA To UBound(lookUpSheetArray, 1)
valueType = lookUpSheetArray(i, LOOKUP_TYPE_COL)
valueGroup = lookUpSheetArray(i, LOOKUP_GROUP_COL)
valueGC = lookUpSheetArray(i, LOOKUP_GC_COL)
bothKey = valueGroup & valueGC
valueChange = lookUpSheetArray(i, LOOKUP_CHANGE_COL)
updateRows = -1 'reset to a non-array value
Select Case valueType
Case "Planning group"
If groupKeys.Exists(valueGroup) Then
updateRows = Split(groupKeys(valueGroup), ",")
End If
Case "GC"
If gcKeys.Exists(valueGC) Then
updateRows = Split(gcKeys(valueGC), ",")
End If
Case "Both"
If bothKeys.Exists(bothKey) Then
updateRows = Split(bothKeys(bothKey), ",")
End If
End Select
'--- update the values if we found the rows to update
If IsArray(updateRows) Then
Dim j As Long
For j = LBound(updateRows, 1) To UBound(updateRows, 1)
updateSheetArray(CLng(updateRows(j)), UPDATE_CHANGE_COL) = valueChange
Next j
End If
Next i
'--- all of the requested updates are complete, copy the array back to the worksheet
updateSheetRange.value = updateSheetArray
End Sub

\$\begingroup\$Hi, thanks this looks and functions very fast. However when the macro finishes to run it deletes all formulas and tables from the updated sheet. Do you know the reason?\$\endgroup\$
– PBPBJul 3 at 9:44