Thread: Comapring two excel worksheets and adding or deleting rows as needed

Good Afternoon,

I am new to VBA coding and need help with excel VBA.

I have one work book with two worksheets, one is a current worksheet (S1) the other is an update version of the first(S2). All columns are the same and each will contain approximately 20,000 rows of data in.

1. I want to compare each cell in column A of S2 to all of column A in S1
a. If cell from S2 is equal to any cell in column A of S1 then do nothing
b. If cell from S2 is not equal to any cell in column A of S1 then add the corresponding row data to S1

2. Compare each cell in cloumn A of S1 to each cell in column A of S2
a. If cell from S1 is equal to any cell in column A of S2 then do nothing
b. If cell from column A of S1 is not equal to any cell in column A of S2 then do:
1. Create new worksheet (S3) and add corresponding row of data to new row in S3
2. Delete corresponding row of data from S1

If you need a sample of the workbook I can sanitize and supply, but preferable on to give out.

Hi dmreno

Welcome to the Forum!

Try this code. The code assumes you have a header row in Row 1 of each worksheet. Let me know of issues

Option Explicit
Sub test()
    Dim lr1 As Long
    Dim lr2 As Long
    Dim lr3 As Long
    Dim nr1 As Long
    Dim nr3 As Long
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim ws3 As Worksheet
    Dim rng1 As Range
    Dim rng2 As Range
    Dim cel1 As Range
    Dim cel2 As Range
    Dim FindString As String

    Set ws1 = ActiveWorkbook.Sheets("Sheet1")
    Set ws2 = ActiveWorkbook.Sheets("Sheet2")
    Set ws3 = ActiveWorkbook.Sheets("Sheet3")

    lr1 = ws1.Range("A" & Rows.Count).End(xlUp).Row
    lr2 = ws2.Range("A" & Rows.Count).End(xlUp).Row
    nr1 = lr1 + 1
    Set rng2 = ws2.Range("A2:A" & lr2)

    For Each cel2 In rng2
        FindString = cel2.Value
        If Trim(FindString) <> "" Then
            With ws1.Range("A2:A" & lr1)
                Set rng1 = .Find(What:=FindString, _
                        After:=.Cells(.Cells.Count), _
                        LookIn:=xlValues, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)
                If rng1 Is Nothing Then
                    cel2.EntireRow.Copy
                    ws1.Range("A" & nr1).PasteSpecial
                    nr1 = nr1 + 1
                    Application.CutCopyMode = False
                End If
            End With
        End If
    Next cel2

    lr1 = ws1.Range("A" & Rows.Count).End(xlUp).Row
    lr3 = ws3.Range("A" & Rows.Count).End(xlUp).Row
    nr3 = lr3 + 1
    Set rng1 = ws1.Range("A2:A" & lr1)

    For Each cel1 In rng1
        FindString = cel1.Value
        If Trim(FindString) <> "" Then
            With ws2.Range("A2:A" & lr2)
                Set rng2 = .Find(What:=FindString, _
                        After:=.Cells(.Cells.Count), _
                        LookIn:=xlValues, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)
                If rng2 Is Nothing Then
                    cel1.EntireRow.Copy
                    ws3.Range("A" & nr3).PasteSpecial
                    nr3 = nr3 + 1
                    cel1.EntireRow.ClearContents
                    Application.CutCopyMode = False
                End If
            End With
        End If
    Next cel1
    With ws1
        lr1 = .Range("A" & Rows.Count).End(xlUp).Row
        .Range("A1:A" & lr1).AutoFilter Field:=1, Criteria1:="="
        .UsedRange.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        .AutoFilterMode = False
    End With
End Sub

Hi David
You're welcome...glad I could help.

Hi dmreno

Yes I received your PM. Been on the road for the last several days with Family responsibilities...haven't paid too much attention to the Forum. I'll look at this probably tomorrow.

Hi dmreno
Dummy up a file that represents what you're working with. Please show examples of S1 and S2. Include S3 that demonstrates what you wish to see in S3. If you choose not to do so, I'll need to do so and I'd prefer not to guess.

Hi dmreno
I've gotta admit, I'm a bit confused about what you're after. The code in the attached does this:

First
With each value in Current Sheet Column A, find it in
Update Sheet Column A; if found, copy Update Sheet Columns
H, I and J values to Current Sheet Columns H, I and J

Second
With each value in Update Sheet Column A, find it in
Current Sheet Column A; if not found, copy Update Sheet entire row
to the next row on Current Sheet

The results I get look nothing like the results you get. Explain a bit further and perhaps we can get on the same page.

Hi dmreno

This code is in the attached and does this:
With each value in OldMel Column A, find it in NewMel Column A; if found, replace NewMel row with OldMel row; if not found do nothing.

Let me know of issues.

Option Explicit
Sub test()
    Dim lr1 As Long
    Dim lr2 As Long
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim rng1 As Range
    Dim rng2 As Range
    Dim cel2 As Range
    Dim FindString As String

    Application.ScreenUpdating = False
    Set ws1 = Sheet1    'NewMel
    Set ws2 = Sheet2    'OldMel

    lr1 = ws1.Range("A" & Rows.Count).End(xlUp).Row
    lr2 = ws2.Range("A" & Rows.Count).End(xlUp).Row
    Set rng2 = ws2.Range("A2:A" & lr2)

    'With each value in OldMel Column A, find it in
    'NewMel Column A;  if found, replace NewMel row with OldMel row;
    'if not found do nothing

    For Each cel2 In rng2    'OldMel
        FindString = cel2.Value
        If Trim(FindString) <> "" Then
            With ws1.Range("A2:A" & lr1)
                Set rng1 = .Find(What:=FindString, _
                        After:=.Cells(.Cells.Count), _
                        LookIn:=xlValues, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)
                If Not rng1 Is Nothing Then
                    '                    Application.Goto rng1, True
                    ws2.Range("A" & cel2.Row).EntireRow.Copy
                    ws1.Range("A" & rng1.Row).PasteSpecial
                    Application.CutCopyMode = False
                End If
            End With
        End If
    Next cel2
    Application.ScreenUpdating = True
End Sub