VBA Question - Performing a loop and do a lookup on large data set very slow

[caru]

Hi All, hoping to get some advice / help.

In short, I have a workbook with a lot of data

Sheet 1 contains around 300,000 rows and 6 columns . In sheet 1, I am using column A and B as my lookup key. Basically if lookup using column A is returning and error then use the lookup key in column B, and if still returning an error then populate "Check"

Sheet 2 contains around 150,000 rows and 98 columns. In sheet 2, column 99, I am performing the lookup process.

What I have right now is a For Loop, to illustrate

For i = 1 to Sheet 2 Last Row
    Result_1 = application.index(rngResult, application.match(sheet2.cells(i,1).value, rngSourceColumnAsheet1,0),1)
    Result_2 = application.index(rngResult, application.match(sheet2.cells(i,1).value, rngSourceColumnBsheet,0),1)
        if iserror(Result_1) then
            ResultFinal = Result_2
                if iserror(Result_2) then
                    ResultFinal = "Check"
                end if
        else
            ResultFinal = Result_1
        end if
    sheet2.cells(i,98).value = ResultFinal
next i

I normally get away with this because my data set is relatively small, but this time around while it works and give the result that I need, it is taking forever to run (I think it is over an hour)

Is there a better way to do this? I have not had much experience with VBA

Thanks!

 

[Peter_SSs]

Welcome to the MrExcel board!

You have given us no sample data and only partial code so it is pretty hard to get a good grip on what you have and what you are trying to do.

Could you give us a small set of dummy sample data (say 10-15 rows, and only relevant columns - hopefully that is not all 99 columns!) and explain in relation to that sample data.
I suggest that you investigate XL2BB for providing sample data to make it easier for helpers by not having to manually type out sample data to test with.

Could we also have the full code so we know how rngResult, rngSourceColumnAsheet1 etc are declared and populated.

 

[caru]

Welcome to the MrExcel board!

You have given us no sample data and only partial code so it is pretty hard to get a good grip on what you have and what you are trying to do.

Could you give us a small set of dummy sample data (say 10-15 rows, and only relevant columns - hopefully that is not all 99 columns!) and explain in relation to that sample data.
I suggest that you investigate XL2BB for providing sample data to make it easier for helpers by not having to manually type out sample data to test with.

Could we also have the full code so we know how rngResult, rngSourceColumnAsheet1 etc are declared and populated.

Hi, thank you. I have uploaded 2 images (mock the data). So basically I am working on the main tab (column ID_1_MOCKUP, and ID_2_MOCKUP are static) and I am looking to populate COLUMN EXPECTED_RESULTS based on the information available in tab mapping. If I can find a match then populate column EXPECTED_RESULTS with MATCHED otherwise populate it with UNMATCHED.

My VBA for this is as follow, which is okay - but given the large data set - I dont believe this is how i supposed to be doing it

Sub test()

Dim wks1, wks2 As Worksheet

Set wks1 = Sheets("main")
Set wks2 = Sheets("mapping")

Dim i, iLr1, iLr2 As Long

iLr1 = wks1.Cells(1, 1).End(xlDown).Row
iLr2 = wks2.Cells(1, 2).End(xlDown).Row

Dim rngID1, rngID2, rngResult As Range

Set rngID1 = wks2.Range("B1:B" & iLr2)
Set rngID2 = wks2.Range("C1:C" & iLr2)
Set rngResult = wks2.Range("A1:A" & iLr2)

Dim sResult1, sResult2, sResult

    For i = 1 To iLr1 - 1
        sResult1 = Application.Index(rngResult, Application.Match(wks1.Cells(i + 1, 1).Value, rngID1, 0), 1)
        sResult2 = Application.Index(rngResult, Application.Match(wks1.Cells(i + 1, 2).Value, rngID2, 0), 1)
            If IsError(sResult1) Then
                sResult = sResult2
                    If IsError(sResult2) Then
                        sResult = "UNMATCHED"
                    Else
                        sResult = "MATCHED"
                    End If
            Else
                sResult = "MATCHED"
            End If
        wks1.Cells(i + 1, 3).Value = sResult
    Next i

MsgBox "done"

End Sub

 

[Peter_SSs]

Thanks for the additional data/information but before a suggested solution a few points.

• When posting vba code in the forum, please use the available code tags. It makes your code much easier to read/debug & copy. My signature block below has more details. I have added the tags for you this time.
  
  
• When declaring multiple variables of the same type you cannot do it as your have done. For example this Dim wks1, wks2 As Worksheet actually declares wks1 as Variant and wks2 as Worksheet. To declare them both as worksheet you have to do it like this Dim wks1 As Worksheet, wks2 As Worksheet
  
  
• It doesn't really matter this time as your sample data is very small but helpers cannot readily copy sample data from an image. You will get much faster/better help if you provide it in a form that can easily be copied. Refer to my previous mention of XL2BB.

With your sample data, remove the expected results from C2:C4 of 'main' and try this code. If no problems, then try it with a copy of your main workbook.
I think that you will find it much faster.

Sub Test_1()
  Dim wks1 As Worksheet, wks2 As Worksheet
  Dim d As Object
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long
  
  Set wks1 = Sheets("main")
  Set wks2 = Sheets("mapping")
  
  Set d = CreateObject("Scripting.Dictionary")
  d.CompareMode = 1
  a = wks2.Range("B2", wks2.Range("C" & Rows.Count).End(xlUp)).Value
  For j = 1 To 2
    For i = 1 To UBound(a)
      d(a(i, j)) = 1
    Next i
  Next j
  With wks1
    a = .Range("A2", .Range("B" & Rows.Count).End(xlUp)).Value
    ReDim b(1 To UBound(a), 1 To 1)
    For i = 1 To UBound(a)
      If d.exists(a(i, 1)) Then
        b(i, 1) = "MATCHED"
      ElseIf d.exists(a(i, 2)) Then
        b(i, 1) = "MATCHED"
      Else
        b(i, 1) = "UNMATCHED"
      End If
    Next i
    .Range("C2").Resize(UBound(b)).Value = b
  End With
End Sub

 

[caru]

Thanks for the additional data/information but before a suggested solution a few points.

• When posting vba code in the forum, please use the available code tags. It makes your code much easier to read/debug & copy. My signature block below has more details. I have added the tags for you this time.
  
  
• When declaring multiple variables of the same type you cannot do it as your have done. For example this Dim wks1, wks2 As Worksheet actually declares wks1 as Variant and wks2 as Worksheet. To declare them both as worksheet you have to do it like this Dim wks1 As Worksheet, wks2 As Worksheet
  
  
• It doesn't really matter this time as your sample data is very small but helpers cannot readily copy sample data from an image. You will get much faster/better help if you provide it in a form that can easily be copied. Refer to my previous mention of XL2BB.

With your sample data, remove the expected results from C2:C4 of 'main' and try this code. If no problems, then try it with a copy of your main workbook.
I think that you will find it much faster.

Sub Test_1()
  Dim wks1 As Worksheet, wks2 As Worksheet
  Dim d As Object
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long
 
  Set wks1 = Sheets("main")
  Set wks2 = Sheets("mapping")
 
  Set d = CreateObject("Scripting.Dictionary")
  d.CompareMode = 1
  a = wks2.Range("B2", wks2.Range("C" & Rows.Count).End(xlUp)).Value
  For j = 1 To 2
    For i = 1 To UBound(a)
      d(a(i, j)) = 1
    Next i
  Next j
  With wks1
    a = .Range("A2", .Range("B" & Rows.Count).End(xlUp)).Value
    ReDim b(1 To UBound(a), 1 To 1)
    For i = 1 To UBound(a)
      If d.exists(a(i, 1)) Then
        b(i, 1) = "MATCHED"
      ElseIf d.exists(a(i, 2)) Then
        b(i, 1) = "MATCHED"
      Else
        b(i, 1) = "UNMATCHED"
      End If
    Next i
    .Range("C2").Resize(UBound(b)).Value = b
  End With
End Sub

Hi Peter,

Thank you very much, It is very fast. The concept of dictionary is very new to me so I did spend sometimes to reading it. Just wondering, would it be possible to return the actual value instead of Matched and Unmatched?

Also, is dictionary always 2 dimensional?

note: I am using work computer so unable to install the add in. But will install one when i get home for future reference.

Thanks again

 

[Peter_SSs]

, would it be possible to return the actual value instead of Matched and Unmatched?

What actual value would it return if it is unmatched?

For the matched ones, is this what you mean? (Changes marked in blue)

Sub Test_2()
  Dim wks1 As Worksheet, wks2 As Worksheet
  Dim d As Object
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long
  
  Set wks1 = Sheets("main")
  Set wks2 = Sheets("mapping")
  
  Set d = CreateObject("Scripting.Dictionary")
  d.CompareMode = 1
  a = wks2.Range("B2", wks2.Range("C" & Rows.Count).End(xlUp)).Value
  For j = 1 To 2
    For i = 1 To UBound(a)
      d(a(i, j)) = 1
    Next i
  Next j
  With wks1
    a = .Range("A2", .Range("B" & Rows.Count).End(xlUp)).Value
    ReDim b(1 To UBound(a), 1 To 1)
    For i = 1 To UBound(a)
      If d.exists(a(i, 1)) Then
        b(i, 1) = a(i, 1)
      ElseIf d.exists(a(i, 2)) Then
        b(i, 1) = a(i, 2)
      Else
        b(i, 1) = "UNMATCHED"
      End If
    Next i
    .Range("C2").Resize(UBound(b)).Value = b
  End With
End Sub