1. Welcome to Chandoo.org Forums. Short message for you

    Hi Guest,

    Thanks for joining Chandoo.org forums. We are here to make you awesome in Excel. Before you post your first question, please read this short introduction guide. When posting or responding to questions please remember our values at Chandoo.org are: Humility, Passion, Fun, Awesomeness, Simplicity, Sharing Remember that we have people here for whom English is not there first language and we need to allow for this in our dealings.

    Yours,
    Chandoo
  2. 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...

  3. 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

Discussion in 'VBA Macros' started by shahin, Sep 15, 2018.

  1. shahin

    shahin Active Member

    Messages:
    899
    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 (vb):

    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.
  2. Marc L

    Marc L Excel Ninja

    Messages:
    4,258

    For each cell of Sheet1 column A use MATCH Excel function
    on Sheet2 column A (or Find VBA method) …​
    shahin likes this.
  3. shahin

    shahin Active Member

    Messages:
    899
  4. Chihiro

    Chihiro Excel Ninja

    Messages:
    5,115
    shahin likes this.
  5. shahin

    shahin Active Member

    Messages:
    899
    If I stick to "Nested Loop", will that be a good choice @sir Chihiro?
  6. Chihiro

    Chihiro Excel Ninja

    Messages:
    5,115
    Not as efficient as other 2.
  7. shrivallabha

    shrivallabha Excel Ninja

    Messages:
    1,920
    @shahin

    Can you post some sample data and expected results. Partial matches can be tricky at times!
    shahin likes this.
  8. shahin

    shahin Active Member

    Messages:
    899
    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.

    Attached Files:

  9. shahin

    shahin Active Member

    Messages:
    899
    I got success using the following script but it takes ages to complete the operation.

    Code (vb):

    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
     
  10. Marc L

    Marc L Excel Ninja

    Messages:
    4,258

    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 …
  11. shrivallabha

    shrivallabha Excel Ninja

    Messages:
    1,920
    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 (vb):
    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!
    shahin likes this.
  12. shahin

    shahin Active Member

    Messages:
    899
    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..
  13. John Jairo V

    John Jairo V Well-Known Member

    Messages:
    501
    Hi to all!

    This code could be an option:
    Code (vb):
    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: Sep 25, 2018
    shahin likes this.
  14. shrivallabha

    shrivallabha Excel Ninja

    Messages:
    1,920
    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!
    shahin likes this.

Share This Page