Matching Sub not working

[Morierus]

Hello,

I have two lists of data, and I need to find the matches between them. I wrote a sub in VBA to do this, but it never runs completely. After inserting a counter, I notice that it always freezes after 236000. I can't seem to find any error with the code, and I'm hoping someone can help me. The code is as follows:


Sub Matching()


Dim i As Long: i = 2
Dim j As Long
Dim k As Long: k = 1
Dim m As Long: m = 1

Dim a As String
Dim b As String

Do

a = Sheet2.Cells(i, 1).Value
j = 2

If i = 10 * k Then

k = k + 1
Sheet1.Cells(1, 80).Value = i

End If


Do

b = Sheet1.Cells(j, 1).Value

If a = b Then

Cells(i, 80).Value = "Match Found"

End If

If j = 10 * m Then

m = m + 1
Sheet1.Cells(1, 81).Value = j

End If

j = j + 1

Loop Until Sheet1.Cells(j + 1, 1).Value = "END"

i = i + 1

Loop Until Sheet2.Cells(i + 1, 1).Value = "END"

End Sub

Also, only the counter in cell(1,81) is activated, it never reaches the counter in cell(1,80).

Can you please help me with this?

 

[Jerry Sullivan]

Hello and Welcome,

I don't see an error per se that is causing your code to freeze up at a single point.
Is it possible that it is running but appears frozen?

Iterating through each item and comparing to each item on the other list
can take a very long time if your lists are long.

One reason why your counter in cell (1,80) appears to not be activated, is that the program
has to run through all your items on Sheet1 ten times before a value is entered in Cell (1,80).

If you have more than 200,000 items in your lists, your program would need to run 2 Million loops
before entering a value in Cell (1,80). It would need to run 400 Billion loops before completing.

Consider using another method of finding matches.
The code example below uses the COUNTIF function and should give you the same result
in a fraction of the time.

Sub Matching2()
    With Sheet2
        With .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
            With .Offset(0, 79)
                .FormulaR1C1 = "=IF(COUNTIF(Sheet1!C1,Sheet2!RC1)>0,""Match Found"","""")"
                .FormulaR1C1 = .Value
            End With
        End With
    End With
End Sub

 

[Morierus]

Dear Jerry,

Thanks for your post. As you guessed, my lists are indeed long: I have over 200,000 items in the Sheet1 list and 3,000 items in the Sheet2 list. Unfortunately, I didn't know how to make the code any more efficient.

I have tried to use your code, but whenever I try to run it, a pop-up window appears asking me to update the values in Sheet1, and requests me to choose a file. Do you know what this is?

Thanks a lot for your help, I really appreciate it.

Best,
Morierus

 

[Jerry Sullivan]

I have tried to use your code, but whenever I try to run it, a pop-up window appears asking me to update the values in Sheet1, and requests me to choose a file. Do you know what this is?

Hi Morierus,

That was my mistake using the wrong type of reference to the sheets.
Each sheet has a Name that appears on the sheet's Tab and a CodeName that you can read in the properties window.

Try this corrected version which references the Codename's Sheet1 and Sheet2.

Sub Matching3()
    Application.ScreenUpdating = False
    With Sheet2
        With .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
            With .Offset(0, 79)
                .FormulaR1C1 = "=IF(COUNTIF('" & Sheet1.Name & "'!C1,'" & _
                    Sheet2.Name & "'!RC1)>0,""Match Found"","""")"
                .FormulaR1C1 = .Value
            End With
        End With
    End With
End Sub

 

[Morierus]

Fantastic. The code works very smoothly now, and it does indeed take a lot less time than before. Turns out you were right, it WAS running, it was just taking forever. Thanks a lot for your help.