• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Can't make use of a loop to compare the content of two sheets

shahin

Active Member
I've written a script which is supposed to compare the content of column A between two sheets in a workbook to find out if there are partial matches. To be clearer: If any of the content of any cell in coulmn A in sheet 1 matches any of the content of any cell in coulmn A in sheet 2 then that will be a match and the script will print that in immediate window.

As I've a very little or no knowledge on vba core functionality, I can't solve it myself. Any help to fix this will be highly appreciated.

I tried like this:
Code:
Sub FindPartialMatch()
    Dim paramlist As Range
   
    Set paramlist = wbO.Sheets(1).Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
   
    For Each cel In wbO.Sheets(2).Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
        If InStr(1, cel(1, 1), paramlist, 1) > 0 Then  'I used "paramlist" here as a placeholder
            Debug.Print cel(1, 1)
        End If
    Next cel
End Sub

The thing is I can't make use of this "paramlist" defined within my script. I just used it there as a placeholder.
 

For each cell of Sheet1 column A use MATCH Excel function
on Sheet2 column A (or Find VBA method) …​
 
Sure @shrivallabha. If any of the content of any cell in coulmn A in sheet 2 matches any of the content of any cell in coulmn A in sheet 1 then the specific content of sheet 1 should be kicked out. Thanks.
 

Attachments

  • Example.xlsx
    758.9 KB · Views: 10
I got success using the following script but it takes ages to complete the operation.

Code:
Sub DeletePartialMatch()
    Dim cel As Range, pcel As Range

    For Each cel In Sheets("Control").Range("A2:A" & Sheets("Control").Cells(Rows.Count, 1).End(xlUp).Row)
        For Each pcel In Sheets("Raw Data").Range("A2:A" & Sheets("Raw Data").Cells(Rows.Count, 1).End(xlUp).Row)
            If InStr(1, cel(1, 1), pcel(1, 1), 1) > 0 Then
                cel(1, 1).EntireRow.ClearContents
            End If
        Next pcel
    Next cel
End Sub
 

Other way : first load Sheet2 column A in a dictionary
then for each cell in Sheet1 column A use the dictionary Exists function
as you can see in samples within threads of any forum
or in VBA inner help …
 
With below changes to your script it runs in about two and half minutes on my laptop. Hopefully it is less than forever.
1. We exit for at first match
2. Range clearing is done at once at the end of the code.
Code:
Public Sub DeletePartialMatch2()
Dim wksCheck As Worksheet: Set wksCheck = ThisWorkbook.Sheets("Sheet1")
Dim wksSource As Worksheet: Set wksSource = ThisWorkbook.Sheets("Sheet2")
Dim rgClear As Range, rgCheck As Range, rgSource As Range
For Each rgCheck In wksCheck.Range("A2:A" & wksCheck.Range("A" & Rows.Count).End(xlUp).Row)
    For Each rgSource In wksSource.Range("A2:A" & wksSource.Range("A" & Rows.Count).End(xlUp).Row)
        If InStr(1, rgCheck, rgSource, vbTextCompare) > 1 Then
            If rgClear Is Nothing Then
                Set rgClear = rgCheck
            Else
                Set rgClear = Union(rgClear, rgCheck)
            End If
            Exit For
        End If
    Next rgSource
Next rgCheck
If Not rgClear Is Nothing Then rgClear.EntireRow.ClearContents
End Sub
If you have formulas etc then some switches such as Application.Calculation will help. Hope this helps!
 
Your solution did reduce the execution time. Earlier with my script It took around 5 minutes. However, with yours it took lees than 2 minutes. I find it slightly difficult to understand your conditional statement. You mentioned above that when the script finds it's first match, it will exit the loop. What if there are multiple matches for a single search? If you guide me how the conditional statement worked, I would be very glad. Ignorance is really like darkness. Btw, your script did the job perfectly. Thanks a lot..
 
Hi to all!

This code could be an option:
Code:
Sub PartialMatch()
    Dim base, dlkup
    Dim sh1 As Worksheet, sh2 As Worksheet
    Dim uf&, uf2&, i&, j&
  
    Set sh1 = Sheets("Sheet1")
    Set sh2 = Sheets("Sheet2")
    uf = sh1.Range("A" & Rows.Count).End(xlUp).Row
    base = sh1.Range("A2:A" & uf).Value2
    uf2 = sh2.Range("A" & Rows.Count).End(xlUp).Row
    dlkup = sh2.Range("A2:A" & uf2).Value2
  
    ReDim res(1 To UBound(base))
    For i = 1 To UBound(base)
        For j = 1 To UBound(dlkup)
            If InStr(1, base(i, 1), dlkup(j, 1), 1) Then
                res(i) = 1: Exit For
            End If
        Next j
    Next i
  
    With sh1.Range("C2:C" & uf)
        .Value2 = Application.Transpose(res)
        .SpecialCells(2).EntireRow.ClearContents
    End With
    Set sh1 = Nothing: Set sh2 = Nothing
    Erase base, dlkup, res
End Sub

Check it. Blessings!
 
Last edited:
Your solution did reduce the execution time. Earlier with my script It took around 5 minutes. However, with yours it took lees than 2 minutes. I find it slightly difficult to understand your conditional statement. You mentioned above that when the script finds it's first match, it will exit the loop. What if there are multiple matches for a single search? If you guide me how the conditional statement worked, I would be very glad. Ignorance is really like darkness. Btw, your script did the job perfectly. Thanks a lot..

Part A]

There are two "For...Next" loops in the code.

Loop 1: Outer loop goes through all cells to be checked and there is no cell skipping here.

Loop 2: Inner loop tries to see if there's a partial match with source or test cells. If we found a match at first entry then is there any point to test further with rest of the cells? No. Therefore we exit Inner Loop the moment we find a match!

Part B]

Interacting with cells in loop to clear or delete them is inherently a bad idea especially if there are dependent formulas (which may not be case with you but in general) so we create a Union of cells fitting the criteria and clear them all in one go!

Hope this helps!
 
Back
Top