Compare columns and create list of duplicates [Solved/Closed]

CarlosIRL - Aug 3, 2016 at 05:16 AM - Latest reply:  CarlosIRL
- Aug 15, 2016 at 09:30 AM
Hello I am a complete newbie when it comes to VBA code but I tried to set up a macro with examples I found online. Let me explain my needs.
I have a file with insured data, one column of which is agency code. Not all agency codes are in the system, therefore I need to compare insured info by agency code to a list of agency codes which are in the system. If I got a match it copies the row over to a new sheet. I know similar case has been discussed here:

Now I can manually add the agency codes to the macro and it works but what id like to do is to have a list of agency codes that are on the system in one sheet(or the same sheet) and let macro check the original sheet with code column against the list (of agency codes in the system) and if the codes match it would copy over those rows.

I'll try to copy with the best thing I came up with and the problematic area:
Sub SearchForString()

Dim LSearchRow As Integer
Dim LCopyToRow As Integer

On Error GoTo Err_Execute

'Start search in row 1
LSearchRow = 1

'Start copying data to row 1 in Sheet2 (row counter variable)
LCopyToRow = 1

While Len(Range("A" & CStr(LSearchRow)).Value) > 0

searchTerm = Range("A3" & i).Text
If Range("F" & CStr(LSearchRow)).Value = searchTerm Then

'Select row in Sheet1 to copy
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select

'Paste row into Sheet2 in next row
Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select

'Move counter to next row
LCopyToRow = LCopyToRow + 1

'Go back to Sheet1 to continue searching

End If

LSearchRow = LSearchRow + 1


'Position on cell A3
Application.CutCopyMode = False

MsgBox "All matching data has been copied."

Exit Sub

MsgBox "An error occurred."

End Sub
This part:
searchTerm = Range("A3" & i).Text
If Range("F" & CStr(LSearchRow)).Value = searchTerm Then
If I leave range as a certain cell and there is match the macro works fine, but if I try to have the range as (A:A) it does not work.

I hope I was clear enough with my explanation if not please ask what is unclear, thank you!
See more 

2 replies

TrowaD 2308 Posts Sunday September 12, 2010Registration dateModeratorStatus March 15, 2018 Last seen - Aug 9, 2016 at 11:21 AM
Hi CarlosIRL,

Let's say:
- Sheet1 has the data of "insured data" with the agency codes in column A.
- Sheet2 has the list of "agency codes in the system", also in column A.

When the agency code on Sheet1 is found on Sheet2 then the entire row from Sheet1 will be copied to Sheet3.

Here is the code:
Sub RunMe()
Dim qFound As Range


For Each cell In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
    Set qFound = Sheets("Sheet2").Columns("A:A").Find(cell.Value)
    If Not qFound Is Nothing Then
        Rows(cell.Row).Copy Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    End If
Next cell


End Sub

Best regards,
Thank you!