Compare columns and create list of duplicates Solved/Closed

Question

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: https://ccm.net/faq/15771-excel-copy-row-if-a-range-of-column-matches-a-value#issue

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
         Selection.Copy

         'Paste row into Sheet2 in next row
         Sheets("Sheet2").Select
         Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
         ActiveSheet.Paste

         'Move counter to next row
         LCopyToRow = LCopyToRow + 1

         'Go back to Sheet1 to continue searching
         Sheets("Sheet1").Select

      End If

      LSearchRow = LSearchRow + 1

   Wend

   'Position on cell A3
   Application.CutCopyMode = False
   Range("A3").Select

   MsgBox "All matching data has been copied."

   Exit Sub

Err_Execute:
   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!

TrowaD · Answer

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

Sheets("Sheet1").Select

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

Sheets("Sheet3").Select

End Sub

Best regards,
Trowa

Compare columns and create list of duplicates

1 response

Similar discussions

Subscribe To Our Newsletter!