Column Comparison Macro

sleuth

New Member
Joined
Jan 12, 2018
Messages
27
I want to write a macro to compare two columns on two separate sheets.
I want to search values in a column against a master list of valid entries for values from another column. The idea is that if a value on the first list does not appear on the second list, then that value is invalid. If it is, I want to copy the entire row for that invalid value and paste it onto another sheet containing a list of invalid entries along for a manual review.

I'm pretty sure I have to create 2 arrays containing these columns and I need to use 2 nested for loops. I've always struggled with loops and I'm new to VBA and need some help. This is what I have so far.



Code:
Sub Find_Invalid_Entries()
    Dim r1 ' last row of the list with survey results
    Dim r2 ' last row of the distribution list
    Dim Range1 As Range
    Dim Range2 As Range
    Dim shtC As Worksheet
    Dim shtB As Worksheet
    Dim C As Integer               'to store the column number of column C in "Survey Results (Raw)"
    Dim B As Integer               'to store the column number of column B in "Distribution List Check"


    Set shtC = Sheets("Distribution List Check") 'storing the sheets...
    Set shtB = Sheets("Survey Results (Raw)")


    shtB.Activate 'no matter you are in the workbook, always run from the sheet B


    r1 = Range("C2").End(xlDown).Row 'the last row of the list with the survey results
                                    
    Set disRange1 = Range(Cells(1, 2), Cells(r1, 2)) 'here need to change the 2 for 1 if you do not want headers
    C = 3 'column C and B, just the numbers
    B = 2


    shtC.Activate 'go to sheet B
    
    r2 = Range("B2").End(xlDown).Row
    Set disRange2 = Range(Cells(1, 2), Cells(r2, 2))
    
    ' Thinking I need to put nested for loops here


End Sub
 

Excel Facts

Is there a shortcut key for strikethrough?
Ctrl+S is used for Save. Ctrl+5 is used for Strikethrough. Why Ctrl+5? When you use hashmarks to count |||| is 4, strike through to mean 5.
You didn't specify the sheet name for the invalid data so I improvised. You can edtit that to the correct sheet name and see if the code below will work for you.

Code:
Sub Find_Invalid_Entries2()
    Dim shtC As Worksheet, c As Range
    Dim shtB As Worksheet
    Set shtC = Sheets("Distribution List Check") 'storing the sheets...
    Set shtB = Sheets("Survey Results (Raw)")
    For Each c In shtB.Range("C2", shtB.Cells(Rows.Count, 3).End(xlUp))
        If Application.CountIf(shtC.Range("B:B"), c.Value) = 0 Then
            c.EntireRow.Copy Sheets("Invalid Entries").Cells(Rows.Count, 1).End(xlUp)(2) 'Edit sheet name
        End If
    Next
End Sub
 
Upvote 0
I wish I could edit my posts. Found a couple mistakes in my original code.

Code:
Sub Find_Invalid_Entries()
    Dim r1 ' last row of the list with survey results
    Dim r2 ' last row of the distribution list
    Dim Range1 As Range
    Dim Range2 As Range
    Dim shtC As Worksheet
    Dim shtB As Worksheet
    Dim C As Integer               'to store the column number of column C in "Survey Results (Raw)"
    Dim B As Integer               'to store the column number of column B in "Distribution List Check"


    Set shtC = Sheets("Distribution List Check") 'storing the sheets...
    Set shtB = Sheets("Survey Results (Raw)")


    shtB.Activate 'no matter you are in the workbook, always run from the sheet B


    r1 = Range("C2").End(xlDown).Row 'the last row of the list with the survey results
                                    
    Set Range1 = Range(Cells(1, 2), Cells(r1, 2)) 'here need to change the 2 for 1 if you do not want headers
    C = 3 'column C and B, just the numbers
    B = 2


    shtC.Activate 'go to sheet B
    
    r2 = Range("B2").End(xlDown).Row
    Set Range2 = Range(Cells(1, 2), Cells(r2, 2))
    
    ' Thinking I need to put nested for loops here


End Sub
 
Upvote 0
You didn't specify the sheet name for the invalid data so I improvised. You can edtit that to the correct sheet name and see if the code below will work for you.

Code:
Sub Find_Invalid_Entries2()
    Dim shtC As Worksheet, c As Range
    Dim shtB As Worksheet
    Set shtC = Sheets("Distribution List Check") 'storing the sheets...
    Set shtB = Sheets("Survey Results (Raw)")
    For Each c In shtB.Range("C2", shtB.Cells(Rows.Count, 3).End(xlUp))
        If Application.CountIf(shtC.Range("B:B"), c.Value) = 0 Then
            c.EntireRow.Copy Sheets("Invalid Entries").Cells(Rows.Count, 1).End(xlUp)(2) 'Edit sheet name
        End If
    Next
End Sub

Thank you. I ran your snippet and it did not appear to do anything at all. Then I realized I had swapped the master list and the 2nd list so I swapped them and tried running again, but again it seems to be doing nothing. I also added the "Invalid Responses" sheet before running and changed the sheet name as you mentioned. Here's what it looks like now.
Code:
Sub Find_Invalid_Entries()
    
    Dim shtC As Worksheet, c As Range
    Dim shtB As Worksheet
    Set shtC = Sheets("Survey Results (Raw)")
    Set shtB = Sheets("Distribution List Check")
    
    For Each c In shtC.Range("C2", shtC.Cells(Rows.Count, 3).End(xlUp))
        If Application.CountIf(shtB.Range("B:B"), c.Value) = 0 Then
            c.EntireRow.Copy Sheets("Invalid Responses").Cells(Rows.Count, 1).End(xlUp)(2)
        End If
    Next


End Sub
 
Upvote 0
Do you have merged cells in either sheet in the source range or the target range? Also try this


Code:
Dim shtC As Worksheet, c As Range
Sub Find_Invalid_Entries()
    Dim shtB As Worksheet
    Set shtC = Sheets("Survey Results (Raw)")
    Set shtB = Sheets("Distribution List Check")    
        For Each c In shtC.Range("C2", shtC.Cells(Rows.Count, 3).End(xlUp))
                If Application.CountIf(shtB.Range("B:B"), "*" & c.Value & "*") = 0 Then
                        c.EntireRow.Copy Sheets("Invalid Responses").Cells(Rows.Count, 1).End(xlUp)(2)
                End If
        Next
End Sub
 
Last edited:
Upvote 0
this is probably a better method to find items with leading or trailing spaces.

Code:
Sub Find_Invalid_Entries()
    Dim shtC As Worksheet, shtB As Worksheet, c As Range
    Set shtC = Sheets(1)
    Set shtB = Sheets(2)
        For Each c In shtC.Range("C2", shtC.Cells(Rows.Count, 3).End(xlUp))
                If shtB.Range("B:B").Find(c.Value, , xlValues, xlPart) Is Nothing Then
                        c.EntireRow.Copy Sheets("Invalid Responses").Cells(Rows.Count, 1).End(xlUp)(2)
                End If
        Next
End Sub
 
Upvote 0
Do you have merged cells in either sheet in the source range or the target range? Also try this

Yes, on "Survey Results (Raw)" and "Invalid Responses" the first and 2nd rows up to the last used column are merged.
 
Last edited:
Upvote 0
Trying to do some error checking. Looking at your code again, it looks like where you used Is Nothing you're trying to copy the lines if No Invalid Responses are found, so I modified it as below.
Code:
Sub Find_Invalid_Entries()
    Dim shtC As Worksheet
    Dim shtB As Worksheet
    Dim c As Range
    Set shtC = Sheets("Survey Results (Raw)")
    Set shtB = Sheets("Distribution List Check")
    MsgBox Join(Application.WorksheetFunction.Transpose(Range("B:B").Value), Chr$(10))
        For Each c In shtC.Range("C2", shtC.Cells(Rows.Count, 3).End(xlUp))
                If shtB.Range("B:B").Find(c.Value, , xlValues, xlPart) Is Nothing Then
                    MsgBox ("No Invalid Entries Found")
                    Exit Sub
                Else
                    c.EntireRow.Copy Sheets("Invalid Responses").Cells(Rows.Count, 1).End(xlUp)(2)
                End If
        Next
End Sub

If I use this code, I get the Msg Box that tells me I nothing in my Range("B:B") and the second Msg Box says I have no invalid entries. So something must be wrong with the comparison.
 
Last edited:
Upvote 0
Ok, with the code below, the first msgbox shows me I now have a range of numbers in Range("B:B") for the active sheet (shtB). The If Statement still takes me to the "No Invalid Entries Found" msgbox.

Code:
Sub Find_Invalid_Entries()
    Dim shtC As Worksheet
    Dim shtB As Worksheet
    Dim c As Range
    Set shtC = Sheets("Survey Results (Raw)")
    Set shtB = Sheets("Distribution List Check")
    shtB.Activate
    MsgBox Join(Application.WorksheetFunction.Transpose(Range("B:B").Value), Chr$(10)) ' For debugging, display contents of Range(B:B) on shtB.
    
        For Each c In shtC.Range("C2", shtC.Cells(Rows.Count, 3).End(xlUp))
                If shtB.Range("B:B").Find(c.Value, , xlValues, xlPart) Is Nothing Then
                    MsgBox ("No Invalid Entries Found")
                    Exit Sub
                Else
                    MsgBox ("Invalid Entries Found. Copied to Invalid Responses Tab for Review")
                    c.EntireRow.Copy Sheets("Invalid Responses").Cells(Rows.Count, 1).End(xlUp)(2)
                End If
        Next
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,546
Messages
6,114,251
Members
448,556
Latest member
peterhess2002

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top