CODEWITHSUNDEEP
excelvbavlookup
DutchArjo
DutchArjo

Reputation: 359

make routine more efficient?

I have this code to find the values that belong to the value in cell C3 (and further down):

aantalrijen = .Range("A2", .Range("A2").End(xlDown)).Cells.Count
    For I = 2 To aantalrijen + 1
        For J = 108 To 112
            For Each cell In .Range(.Cells(2, J), .Cells(aantalrijen, J)).Cells
                cell.Value = Application.VLookup(.Cells(I, 3), Sheets("omzet").Range("C:DH"), J - 2, 0)
            Next cell
        Next J
    Next I

I am aware this cannot be the most efficient way to get the desired result. How should I adjust the code to make it the most efficient?

Update:

For now I am satisfied with this result:

aantalrijen = .Range("A2", .Range("A2").End(xlDown)).Cells.Count
    For J = 108 To 112
        For I = 2 To aantalrijen
            .Cells(I, J).Value = Application.VLookup(.Cells(I, 3), Sheets("omzet").Range("C:DH"), J - 2, 0)
        Next I
    Next J

End With

it is fast enough for me now and it returns the desired results.

Upvotes: 0

Views: 37

Answers (1)

Damian
Damian

Reputation: 5174

Here:

Option Explicit
Sub Test()

    Dim arrSource, arrData, i As Long, j As Long, ColI As Long, ColF As Long
    Dim DictMatches As New Scripting.Dictionary
    Dim DictHeaders As New Scripting.Dictionary

    With ThisWorkbook
        arrSource = .Sheets("omzet").UsedRange.Value
        arrData = .Sheets("SheetName").UsedRange.Value 'change this for the worksheet you are working on
    End With

    For i = 1 To UBound(arrSource, 2) 'this will store the headers position
        DictHeaders.Add arrSource(1, i) 'this will throw an error if you have any duplicate headers
    Next i

    For i = 2 To UBound(arrSource) 'this will store the row position for each match
        DictMatches.Add arrSource(i, 3), i 'this will throw an error if you have any duplicates
    Next i

    'Here you can change where you want to evaluate your data
    ColI = 108
    ColF = 112

    For i = 2 To UBound(arrData) 'loop through rows
        For j = ColI To ColF 'loop through columns
            arrData(i, j) = arrSource(DictMatches(arrData(i, 3), DictHeaders(1, j)))
        Next j
    Next i

    'Paste the arrData back to the sheet
    ThisWorkbook.Sheets("SheetName").UsedRange.Value = arrData

End Sub

This is the fastest way, why?

  1. You store both sheets into the arrays and from then on you work only with the arrays(which means working on memory, so working faster)
  2. Using excel functions always slow downs the process, instead we are storing all the index values on rows and headers for the omzet sheet, so when you point to a value from Column C on your working sheet, it gives you the result without calculating anything.

Here: arrSource(DictMatches(arrData(i, 3), DictHeaders(1, j))) we are giving a row position and column position.

DictMatches(arrData(i, 3) will give you back the row where that match was found inside the dicitonary. DictHeaders(1, j) will give you back the column where that header was found inside the dictionary.

Note: for dictionaries to work you need the Microsoft Scripting Runtime library checked on your references. Also Dictionaries are Case Sensitiveso Hello <> hello.

Upvotes: 1

Related Questions