What is the most efficient way in Excel VBA to reference adjacent cells?

Question

I was trying to use a with statement since they are faster than a loop.

There are 72,000 rows, the exact number can vary. An item code needs to go in column A depending on the currency code in column B.

I am referencing a collection to retrieve the code based on the currency code. What is the fastest way I can accomplish this? Here is my code... which doesnt work.

Sub Collector()

Dim cn As Collection
Dim LastRow As Long
Dim cur As Long
Dim destws As Worksheet

Set destws = ThisWorkbook.Worksheets("Data")

Set cn = New Collection
cn.Add "120000037650264", "AUD"
cn.Add "140000028802654", "CAD"
cn.Add "106000061411232", "CHF"
cn.Add "100700037144679", "CNY"
cn.Add "108000077165454", "EUR"
cn.Add "100900028865402", "GBP"
cn.Add "100700034152263", "HKD"
cn.Add "103000037165403", "HUF"
cn.Add "100400055172256", "INR"
cn.Add "100090035614270", "JPY"
cn.Add "100600035472288", "KRW"
cn.Add "100040036172267", "MXN"
cn.Add "100004036162300", "PLN"
cn.Add "121000037176585", "RUB"
cn.Add "133000040272294", "THB"
cn.Add "100430020172276", "TWD"
cn.Add "109790029172291", "UAH"
cn.Add "100004007305201", "USD"
cn.Add "100003051687277", "ZAR"

LastRow = destws.Cells(Rows.Count, 2).End(xlUp).Row


    With destws.Range("A2:A" & LastRow)
        .Value = cn.Item(Cells(cur, 2).Value) 'generates object defined error
    End With

End Sub

Example: I want cell A2 to have a value of 100004007305201 if cell B2 value is USD.

Any help would be greatly appreciated!

Answer 1

My initial thougth was that you didn't define cur which could be defined as follow if you where only looking at one cell (A2):

With destws.Range("A2")
    cur = .Column + 1
    .Value = cn.Item(Cells(cur, 2).Value)
End With

But since you are looking at a lot of cells, it would be better to use an array to write to the cells all at once, which can highly increase the speed.

Sub Collector()

Dim cn As Collection
Dim LastRow As Long
Dim destws As Worksheet

Set destws = ThisWorkbook.Worksheets("Data")


Set cn = New Collection
cn.Add "120000037650264", "AUD"
cn.Add "140000028802654", "CAD"
cn.Add "106000061411232", "CHF"
cn.Add "100700037144679", "CNY"
cn.Add "108000077165454", "EUR"
cn.Add "100900028865402", "GBP"
cn.Add "100700034152263", "HKD"
cn.Add "103000037165403", "HUF"
cn.Add "100400055172256", "INR"
cn.Add "100090035614270", "JPY"
cn.Add "100600035472288", "KRW"
cn.Add "100040036172267", "MXN"
cn.Add "100004036162300", "PLN"
cn.Add "121000037176585", "RUB"
cn.Add "133000040272294", "THB"
cn.Add "100430020172276", "TWD"
cn.Add "109790029172291", "UAH"
cn.Add "100004007305201", "USD"
cn.Add "100003051687277", "ZAR"

LastRow = destws.Cells(Rows.Count, 2).End(xlUp).Row

Dim MyArray() As Variant
MyArray() = destws.Range("B2:B" & LastRow)

Dim i As Long
For i = 1 To UBound(MyArray,1)
    MyArray(i, 1) = cn.Item(MyArray(i, 1))
Next i

destws.Range("A2:A" & LastRow).Value2 = MyArray


End Sub

Answer 2

Accessing Collection items by index is definitely a performance issue. Collections want to be iterated in a For Each loop! If you know in advance how many items you'll need, best use an array; accessing array items by index is exactly what arrays do best (and that's why they're best iterated with a For loop).

Writing to a Range in a loop is also highly inefficient.

Now, you're not dumping collection/array items into a Range - you're looking up key/value pairs. The single most efficient way to do this is with a Dictionary. A Collection can be keyed (as you did) too, but I like calling a cat a cat, so I use a Dictionary for key-value pairs.

Note: I'm going to assume your key/value pairs are account/currency. Adjust as needed; the idea is to name things, so that the code speaks for itself.

You could have a Private Function CreateAccountsByCurrencyDictionary that creates, populates and returns a Dictionary, and then your macro could have a Static local variable (so that it's not uselessly re-initialized every time the macro is invoked) to hold it:

Static accountsByCurrency As Scripting.Dictionary 'reference Microsoft Scripting Runtime
If accountsByCurrency Is Nothing Then
    Set accountsByCurrency = CreateAccountsByCurrencyDictionary
End If

Then you grab your working range and dump it into a 2D array - the simplest way is to have your data live in a ListObject (i.e. a named table); you can easily convert your range into a table by selecting "format as table" from the Home Ribbon tab - then you don't need to track where the last row is, the table does it for you!

Here Sheet1 is the code name of the worksheet you need to work with. Always qualify Range calls with a specific worksheet object. By using the sheets' code name, you make your code work regardless of what the ActiveSheet is.

Dim target As Range
Set target = Sheet1.ListObjects("TableName").DataBodyRange

Dim values As Variant
values = target.Value

Now that you have a 2D array (values), iterate it with a For loop and do your lookups:

Dim currentRow As Long
For currentRow = LBound(values, 1) To UBound(values, 1)

    ' never assume you're looking at valid data
    Dim currentKeyValue As Variant
    currentKeyValue = values(currentRow, 1)
    Debug.Assert Not IsError(currentKeyValue) ' there's a problem in the data

    ' key is a valid string, but might not exist in the lookup dictionary
    Dim currentKey As String
    currentKey = currentKeyValue
    If accountsByCurrency.Exists(currentKey) Then
        ' lookup succeeded, update the array:
        values(currentRow, 1) = accountsByCurrency(currentKey)
    Else
        Debug.Print "Key not found: " & currentKey, "Index: " & currentRow
        Debug.Assert False ' dictionary is missing a key. what now?
    End If
Next

If all goes well the values array now contains your corrected values, you can update the actual worksheet - and since you have the values in a 2D array, that's a single instruction!

target.Value = values

The CreateAccountsByCurrencyDictionary function might look something like this:

Private Function CreateAccountsByCurrencyDictionary() As Scripting.Dictionary
    Dim result As Scripting.Dictionary
    Set result = New Scripting.Dictionary
    With result
        .Add "AUD", "120000037650264"
        .Add "CAD", "140000028802654"
        '...
    End With
    Set CreateAccountsByCurrencyDictionary = result
End Function

Or, the values could be populated from another worksheet table instead of being hard-coded. Point being, how the lookup values are acquired is a concern in its own right, and belongs in its own scope/procedure/function.

Answer 3

From a quick look, you use cur similar to that in a loop, which would go over your array and make the change, e.g.:

Dim cur as Long, lr as Long
lr = cells(rows.count, 1).end(xlup).row 'dynamic last row
For cur = 2 to lr step 1
    Select Case Cells(cur,3).Value
    Case "AUD"
        Cells(cur,2).value = "120000037650264"
    Case "" 'add in others
        Cells...blah blah blah        
    End Select
Next i

It would make the most sense, given you have a table with these values, to just use a formula with either a vlookup or index/match, e.g.:

'Where your table is on Sheet2 with Column A being the currency code (3-letter code) code and Column B being the item code
'Where you are working on Sheet1
=INDEX(Sheet2!B:B,MATCH(Sheet1!C1,Sheet2!A:A,0)) 'in column B for the active row

Answer 4

How about this;

Sub Collector()

Dim cn As Collection
Dim LastRow As Long
Dim cur As Long
Dim ws As Worksheet: Set ws = Sheets("Sheet1")
'declare and set your worksheet, amend as required.
Set cn = New Collection
cn.Add "120000037650264", "AUD"
cn.Add "140000028802654", "CAD"
cn.Add "106000061411232", "CHF"
cn.Add "100700037144679", "CNY"
cn.Add "108000077165454", "EUR"
cn.Add "100900028865402", "GBP"
cn.Add "100700034152263", "HKD"
cn.Add "103000037165403", "HUF"
cn.Add "100400055172256", "INR"
cn.Add "100090035614270", "JPY"
cn.Add "100600035472288", "KRW"
cn.Add "100040036172267", "MXN"
cn.Add "100004036162300", "PLN"
cn.Add "121000037176585", "RUB"
cn.Add "133000040272294", "THB"
cn.Add "100430020172276", "TWD"
cn.Add "109790029172291", "UAH"
cn.Add "100004007305201", "USD"
cn.Add "100003051687277", "ZAR"

LastRow = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row

Application.Calculation = xlManual
    For i = 2 To LastRow
        ws.Cells(i, 1).Value = cn.Item(ws.Cells(i, 2).Value)
    Next i
Application.Calculation = xlCalculationAutomatic
End Sub