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

Answer 1

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

Answer 2

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

Answer 3

Thank you very much ASH 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.