vba excel vlookup using arrays

Question

I Have the following code, which works, but is a bit slow, I would like to do the same but using arrays

Sub AddValues()
 Dim Srng As Range
 Dim search_value As Variant

  PG = "Data"
  Ln = 2

  Set Srng = Worksheets("Coniguration").Range("_Configuration")
  LastRow = Worksheets("Data").Range("A1").CurrentRegion.Rows.Count

    For Ln = 2 To LastRow
     search_value = Val(ActiveWorkbook.Sheets(PG).Cells(Ln, "A").Value)
      ActiveWorkbook.Sheets("Data").Cells(Ln, "CA").Value = Application.VLookup(search_value, Srng, 3, False)
      ActiveWorkbook.Sheets("Data").Cells(Ln, "CB").Value = Application.VLookup(search_value, Srng, 4, False)
      ActiveWorkbook.Sheets("Data").Cells(Ln, "CC").Value = Application.VLookup(search_value, Srng, 5, False)
      ActiveWorkbook.Sheets("Data").Cells(Ln, "CD").Value = Application.VLookup(search_value, Srng, 6, False)
      ActiveWorkbook.Sheets("Data").Cells(Ln, "CF").Value = Application.VLookup(search_value, Srng, 7, False)

    Next Ln
End Sub

A.S.H · Accepted Answer · 2017-07-13 01:46:51Z

One sure source of slowness is that you are doing the same search 5 times in each iteration. You can instead find the matching row only once, then copy the cells from the matched row. Also interesting is to get a sheet reference once and avoid fetching the worksheet with Worksheets(name) in every iteration.

Sub AddValues()
  Dim Srng As Range, Ln As Long, matchRow, search_value
  Set Srng = Worksheets("Configuration").Range("_Configuration")

  With Worksheets("Data")
    For Ln = 2 To .Cells(.Rows.count, "A").End(xlUp).row
      search_value = val(.Cells(Ln, "A").Value2)

      ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
      ' Find matching row only once and copy the results
      matchRow = Application.match(search_value, Srng.Columns(1), 0)
      If IsError(matchRow) Then
        Debug.Print search_value & " : Not found"
      Else
        .Cells(Ln, "CA").Resize(, 4).value = Srng.Cells(matchRow, 3).Resize(, 4).Value2
        .Cells(Ln, "CF").value = Srng.Cells(matchRow, 7).Value2
      End If
    Next Ln
  End With
End Sub

user6585761 · Accepted Answer · 2017-07-13 03:07:19Z

Here's a method that avoids looping. First it enters the formula in the target cells, and then it converts the formulas into values.

Sub AddValues()

    Dim Srng As Range
    Dim LastRow As Long

    Set Srng = Worksheets("Coniguration").Range("_Configuration")

    With Worksheets("Data")
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        With .Range("CA2:CA" & LastRow)
            .FormulaR1C1 = "=VLOOKUP(RC1," & Srng.Address(, , xlR1C1, True) & ", 3, 0)"
            .Value = .Value
        End With
        With .Range("CB2:CB" & LastRow)
            .FormulaR1C1 = "=VLOOKUP(RC1," & Srng.Address(, , xlR1C1, True) & ", 4, 0)"
            .Value = .Value
        End With
        With .Range("CC2:CC" & LastRow)
            .FormulaR1C1 = "=VLOOKUP(RC1," & Srng.Address(, , xlR1C1, True) & ", 5, 0)"
            .Value = .Value
        End With
        With .Range("CD2:CD" & LastRow)
            .FormulaR1C1 = "=VLOOKUP(RC1," & Srng.Address(, , xlR1C1, True) & ", 6, 0)"
            .Value = .Value
        End With
        With .Range("CF2:CF" & LastRow)
            .FormulaR1C1 = "=VLOOKUP(RC1," & Srng.Address(, , xlR1C1, True) & ", 7, 0)"
            .Value = .Value
        End With
    End With

End Sub

Alex · Accepted Answer · 2017-07-13 20:22:43Z

0

Thank you very much A.S.H and Domenic, both methods work much better than my code.

At the end I'll use the one provided by Domenic as it is the fastest one.

answered Jul 13, 2017 at 20:22

Alex

11 silver badge2 bronze badges

Collectives™ on Stack Overflow

vba excel vlookup using arrays

3 Answers 3

Comments

Comments

Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

3 Answers 3

Comments

Comments

Comments

Your Answer

Sign up or log in

Post as a guest

Related