Massive Data VLookup Spanning Multiple Ranges

[breynolds0431]

Hello. Looking for a solution to the below. I basically have a user-input file where the ID that the user enters should retrieve 3 pieces of data relevant to that ID with a VLOOKUP. The problem is that the data source is very large. I've put all the data on one excel tab, thinking that would make things more efficient, and given a named range to each group. So the VLOOKUP i have checks each range, which is obviously sluggish as each range exceeds the row limit of excel. Thank you for your time!

Sub pleasehelp ()

With Application

    .ScreenUpdating = False
    .EnableEvents = False
    .DisplayAlerts = False
    .Calculation = xlCalculationManual

End With

Set wsh = Worksheets("MEDataGrab")

Workbooks.Open Filename:="C:\Desktop\MEDataFiles.xlsb"

    i = 7
 
    While wsh.Cells(i, 2) <> ""

        wsh.Cells(i, 3).FormulaR1C1 = _
        "=iferror(VLOOKUP(RC[-1],'MEDataFiles.xlsb'!MEData1,2,FALSE),iferror(VLOOKUP(RC[-1],'MEDataFiles.xlsb'!MEData2,2,FALSE),iferror(VLOOKUP(RC[-1],'MEDataFiles.xlsb'!MEData3,2,FALSE),"""")))"

        wsh.Cells(i, 4).FormulaR1C1 = _
        "=iferror(VLOOKUP(RC[-2],'MEDataFiles.xlsb'!MEData1,3,FALSE),iferror(VLOOKUP(RC[-2],'MEDataFiles.xlsb'!MEData2,3,FALSE),iferror(VLOOKUP(RC[-2],'MEDataFiles.xlsb'!MEData3,3,FALSE),"""")))"

        wsh.Cells(i, 5).FormulaR1C1 = _
        "=iferror(VLOOKUP(RC[-3],'MEDataFiles.xlsb'!MEData1,4,FALSE),iferror(VLOOKUP(RC[-3],'MEDataFiles.xlsb'!MEData2,4,FALSE),iferror(VLOOKUP(RC[-3],'MEDataFiles.xlsb'!MEData3,4,FALSE),"""")))"

        i = i + 1
 
    Wend

    Columns("C:E").Select
    Selection.Copy
    Range("C1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Workbooks("MEDataFiles.xlsb").Close SaveChanges:=False


With Application

    .ScreenUpdating = True
    .EnableEvents = True
    .DisplayAlerts = True
    .Calculation = xlCalculationAutomatic

End With

End Sub

 

[DanteAmor]

Check if the following works for you.
To try:
- First open your book "MEDataFiles.xlsb"
- In the book "MEDataFiles.xlsb" you must have the data ranges: "MEData1", "MEData2" and "MEData3".
- The result will be in the "MEDataGrab" sheet starting in cell C7.

Sub MassiveDataVLookup()
  Dim sh As Worksheet, i As Long, wb2 As Workbook
  Dim a As Variant, b As Variant, m1 As Variant, m2 As Variant, m3 As Variant
  Dim mDic1 As Object, mDic2 As Object, mDic3 As Object
  
  Set sh = Worksheets("MEDataGrab")
  Set wb2 = Workbooks("MEDataFiles.xlsb")
  
  Set mDic1 = CreateObject("Scripting.Dictionary")
  Set mDic2 = CreateObject("Scripting.Dictionary")
  Set mDic3 = CreateObject("Scripting.Dictionary")
  
  m1 = wb2.Names("MEData1").RefersToRange
  m2 = wb2.Names("MEData2").RefersToRange
  m3 = wb2.Names("MEData3").RefersToRange
  
  For i = 1 To UBound(m1, 1)
    mDic1(m1(i, 1)) = m1(i, 2) & "|" & m1(i, 3) & "|" & m1(i, 4)
  Next
  For i = 1 To UBound(m2, 1)
    mDic2(m2(i, 1)) = m2(i, 2) & "|" & m2(i, 3) & "|" & m2(i, 4)
  Next
  For i = 1 To UBound(m3, 1)
    mDic3(m3(i, 1)) = m3(i, 2) & "|" & m3(i, 3) & "|" & m3(i, 4)
  Next
  
  a = sh.Range("B7", sh.Range("B" & Rows.Count).End(xlUp))
  ReDim b(1 To UBound(a), 1 To 3)
  For i = 1 To UBound(a)
    If mDic1.exists(a(i, 1)) Then
      b(i, 1) = Split(mDic1(a(i, 1)), "|")(0)
      b(i, 2) = Split(mDic1(a(i, 1)), "|")(1)
      b(i, 3) = Split(mDic1(a(i, 1)), "|")(2)
    Else
      If mDic2.exists(a(i, 1)) Then
        b(i, 1) = Split(mDic2(a(i, 1)), "|")(0)
        b(i, 2) = Split(mDic2(a(i, 1)), "|")(1)
        b(i, 3) = Split(mDic2(a(i, 1)), "|")(2)
      Else
        If mDic3.exists(a(i, 1)) Then
          b(i, 1) = Split(mDic3(a(i, 1)), "|")(0)
          b(i, 2) = Split(mDic3(a(i, 1)), "|")(1)
          b(i, 3) = Split(mDic3(a(i, 1)), "|")(2)
        End If
      End If
    End If
  Next
  sh.Range("C7").Resize(UBound(b), 3).Value = b
End Sub

 

[DanteAmor]

I put a more compact version of my macro:

Sub MassiveDataVLookup1()
  Dim sh As Worksheet, i As Long, wb2 As Workbook, mDic1 As Object
  Dim a As Variant, b As Variant, m1 As Variant, m2 As Variant, m3 As Variant
  
  Set sh = Worksheets("MEDataGrab")
  Set wb2 = Workbooks("MEDataFiles.xlsb")
  Set mDic1 = CreateObject("Scripting.Dictionary")
  
  m1 = wb2.Names("MEData1").RefersToRange
  m2 = wb2.Names("MEData2").RefersToRange
  m3 = wb2.Names("MEData3").RefersToRange
  
  For i = 1 To UBound(m1, 1)
    mDic1(m1(i, 1)) = m1(i, 2) & "|" & m1(i, 3) & "|" & m1(i, 4)
  Next
  For i = 1 To UBound(m2, 1)
    mDic1(m2(i, 1)) = m2(i, 2) & "|" & m2(i, 3) & "|" & m2(i, 4)
  Next
  For i = 1 To UBound(m3, 1)
    mDic1(m3(i, 1)) = m3(i, 2) & "|" & m3(i, 3) & "|" & m3(i, 4)
  Next
  
  a = sh.Range("B7", sh.Range("B" & Rows.Count).End(xlUp))
  ReDim b(1 To UBound(a), 1 To 3)
  For i = 1 To UBound(a)
    If mDic1.exists(a(i, 1)) Then
      b(i, 1) = Split(mDic1(a(i, 1)), "|")(0)
      b(i, 2) = Split(mDic1(a(i, 1)), "|")(1)
      b(i, 3) = Split(mDic1(a(i, 1)), "|")(2)
    End If
  Next
  sh.Range("C7").Resize(UBound(b), 3).Value = b
End Sub

 

[breynolds0431]

Hi @DanteAmor. Thanks very much for the macro. But, I now realize I need another field analyzed and the formula would be better as a Index Match formula. The good news is that I was able to update the source data as I needed to and exported all rows into one .csv file. So, no more numerous ranges to look at. Is there anyway to apply the memory formulas you do to the following array formula?

Cell for Formula = D9

{=INDEX('[MEDataFiles.xlsb]MEData'!$B:$B,MATCH(1,IF(C9>='[MEDataFiles.xlsb]MEData'!$C:$C,IF(C9<='[MEDataFiles.xlsb]MEData'!$D:$D,IF(B9='[MEDataFiles.xlsb]MEData'!$A:$A,1,1))),0))}

 

[DanteAmor]

It seems a different requirement than the original. Perhaps, calculations can be made in memory. You could create a new thread, there explain with examples the operation of the formula.