Converting Multiple Criteria Xlookup to VBA

[MojoJojo2023]

Hi all! I am trying to convert this Xlookup function to VBA to improve the speed of my workbook. I am trying to get VBA to insert the product of this formula into every cell from B2 to the last row:

=(XLOOKUP(1,(J5<=Sheet2!$H:$H)*(J5>=Sheet2!$G:$G)*(F5=Sheet2!$E:$E),Sheet2!$L:$L))

Does anyone know how this can be applied with Application.WorksheetFunction.Xlookup?

Thanks!

 

[DanteAmor]

Check with the following improvement.

Instead of using the entire column, put a considerable number of rows, planning for moderate growth in your data on sheet2, for example, if you have 1000 rows with data, you can put 1500:

=(XLOOKUP(1,(J5<=Sheet2!$H1:$H1500)*(J5>=Sheet2!$G1:$G1500)*(F5=Sheet2!$E1:$E1500),Sheet2!$L1:$L1500))

----- --
Let me know the result and I'll get back to you as soon as I can.
Sincerely
Dante Amor
----- --

 

[DanteAmor]

If you still want the macro.

In the next statement, you want the result in cell B2 and down.
But you don't say which sheet.

I am trying to get VBA to insert the product of this formula into every cell from B2 to the last row:

In the macro change "Sheet1" on this line to the name of your sheet where you want the results.
Set sh1 = Sheets("Sheet1") 'fit your sheet name


Run this code:

Sub xlookup_to_vba()
  Dim dic As Object
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim a As Variant, b As Variant, c As Variant, d As Variant
  Dim i&, j&, lr&, y&, nRow&, nCol&, fila&
 
  Set dic = CreateObject("Scripting.Dictionary")
  Set sh1 = Sheets("Sheet1")    'fit your sheet name
  Set sh2 = Sheets("Sheet2")
 
  'data from sheet2
  lr = sh2.Range("E:L").Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row
  a = sh2.Range("A1:L" & lr).Value2
  ReDim b(1 To UBound(a), 1 To 4)
 
  'data from sheet1
  lr = sh1.Range("F" & Rows.Count).End(3).Row
  c = sh1.Range("F2:J" & lr).Value2
  ReDim d(1 To UBound(c), 1 To 1)
 
  'index col "E". stores in 'b' the rows of the array 'a'
  For i = 1 To UBound(a, 1)
    If Not dic.exists(a(i, 5)) Then
      y = y + 1
      dic(a(i, 5)) = y & "|" & 1
    End If
    nRow = Split(dic(a(i, 5)), "|")(0)
    nCol = Split(dic(a(i, 5)), "|")(1)
    b(nRow, nCol) = i
    dic(a(i, 5)) = nRow & "|" & nCol + 1
  Next
 
  'read 'c' and search the index, loop through the rows of array 'a' and check the conditions
  For i = 1 To UBound(c)
    If dic.exists(c(i, 1)) Then
      nRow = Split(dic(c(i, 1)), "|")(0)
      nCol = Split(dic(c(i, 1)), "|")(1)
      For j = 1 To nCol - 1
        fila = b(nRow, j)
        If a(fila, 7) <= c(i, 5) And a(fila, 8) >= c(i, 5) Then
          d(i, 1) = a(fila, 12)
          Exit For
        End If
      Next
    End If
  Next
 
  '
  sh1.Range("B2").Resize(UBound(d)).Value = d
End Sub

----- --
I hope to hear from you soon.
Respectfully
Dante Amor
----- --