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

VBA Code to compare data between 2 sheets and copy differences in a different sheet

Gautam Varma

New Member
I'm trying to create a macro to track defaulters in excel. For Step 1 I pull a list of Names and Email Subjects into an excel Workbook (Columns A & B Sheet1) from a particular Outlook Folder. In the same Excel Sheet I have a Master List of names in the second worksheet (Column A Sheet2). I want to compare the two and copy entire row data from the Master List Sheet of all those names that aren't present in Sheet1 (i.e. Defaulters or those who havent sent me an email). This is the code that i've tried so far. I have got it to highlight cells in Sheet2 but im unable to copy these highlighted cells dynamically into Sheet3. Could use some help! Thanks in Advance.


Code:
    Option Explicit
  
    Sub test()
    Dim i As Long
    Dim arrSum As Variant, arrUsers As Variant
    Dim cUnique As New Collection
  
    'Put the name range from "Summary" in an array
    With ThisWorkbook.Sheets("Sheet2")
        arrSum = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
    End With
  
    '"Convert" the array to a collection (unique items)
    For i = 1 To UBound(arrSum, 1)
        On Error Resume Next
        cUnique.Add arrSum(i, 1), CStr(arrSum(i, 1))
    Next i
  
    'Get the users array
    With ThisWorkbook.Sheets("Sheet1")
        arrUsers = .Range("A1", .Range("A" & Rows.Count).End(xlUp))
    End With
  
    'Check if the value exists in the Users sheet
    For i = 1 To cUnique.Count
        'if can't find the value in the users range, delete the rows
        If Application.WorksheetFunction.VLookup(cUnique(i), arrUsers, 1, False) = "#N/A" Then
            With ThisWorkbook.Sheets("Sheet2").Cells
                .AutoFilter Field:=1, Criteria1:=cUnique(i)
                .Range("A2", .Range("A" & Rows.Count).End(xlUp)).EntireRow.Interior.ColorIndex = 35
              
            End With
        End If
    Next i
    'removes AutoFilter if one remains
    ThisWorkbook.Sheets("Sheet2").AutoFilterMode = False
  
    End Sub
 
Hi, Gustam Varma!

You can also give a look at this link:
http://chandoo.org/forum/threads/comparing-two-spreadsheets-for-changes.10054/#post-57562

Please be aware that unfortunately the posted code suffers from CDIAFM (aka collateral damage issue after forums migration) and the code is unindented and special characters are replaced by "&#nnn:" (unquoted) being nnn the ASCII code for that char. They're supposed to be fixed and updated each time we (Ninjas) stump into them (yes, manually, post by post), but as the code is within the linked file I hope you'll manage to handle it.

But the file still works fine! No efforts against it have succeeded :p

Regards!
 
Always a fan of SirJB7's acronyms. :DD
I had some extra time this morning, so fixed the code within the post as well.
 
@Luke M
Hi, buddy!
I still remember your CASFFML long time chronic illness, and my secretary/assistant job done at those times... ;)
But about your 2nd line... :oops:
I had some extra time this morning, so fixed the code within the post as well.
weren't @this guy and @this guy going to solve it almost a year ago? :eek:
Are you telling me that they did nothing (at least successful) in all that time? o_O
I hardly can believe it... Very disappointed... :rolleyes:
Regards!
 
Back
Top