How to compare two sheets and delete unwanted data?

[stigvage]

Anyone knows how to compare two sheets, say sheet "A" and "B",

deleting data (rows) in sheet B which is not found in sheet A, and

copying data (rows) from sheet A which is not present in sheet B?

Data (rows) found both in sheet A and B should stay untouched.


Best regards

Stig
Norway

 

[ravishankar]

Hi
Paste the following codes in the macro window ( alt F11)

Sub compare()
x = Worksheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Row
y = Worksheets("sheet2").Cells(Rows.Count, 1).End(xlUp).Row
For a = y To 2 Step -1
Worksheets("sheet2").Cells(1, 1) = "=iserror(match(A" & a & ",sheet1!A1:A" & x & ",0))"
If Worksheets("sheet2").Cells(1, 1) = True Then
Worksheets("sheet2").Rows(a).Delete
End If
Next a
z = Worksheets("sheet2").Cells(Rows.Count, 1).End(xlUp).Row
For b = 2 To x
Worksheets("sheet1").Cells(1, 1) = "=iserror(match(A" & a & ",sheet2!A1:A" & z & ",0))"
If Worksheets("sheet1").Cells(1, 1) = True Then
Worksheets("sheet1").Rows(b).Copy
Worksheets("sheet2").Rows(z + 1).PasteSpecial
z = z + 1
End If
Next b
End Sub

Run the macro. If it does not meet your expectation, let me know, I will modify it suitably.
RAvi

 

[stigvage]

Hi, thanks for the reply.

The first part seems to work just fine (deleting), but data in sheet A not present in sheet B doesn't copy to sheet B.

Do you have a suggestion?


Best regards
Stig
Norway

 

[Legacy 14611]

Hei Stigvage

Sub rowsandstuff()
Dim a, b, c(), ra(), rb(), p, q
a = Sheets("A").UsedRange
b = Sheets("B").UsedRange
na = UBound(a, 1): ma = UBound(a, 2)
nb = UBound(b, 1): mb = UBound(b, 2)
ReDim ra(1 To na), rb(1 To nb), c(1 To na)
For i = 1 To na
    For j = 1 To ma
        If j = 1 Then
            ra(i) = a(i, j)
        Else: ra(i) = ra(i) & Chr(30) & a(i, j)
        End If
Next j, i
For i = 1 To nb
    For j = 1 To mb
        If j = 1 Then
            rb(i) = b(i, j)
        Else: rb(i) = rb(i) & Chr(30) & b(i, j)
        End If
Next j, i
For j = 1 To nb
    For i = 1 To na
        If ra(i) = rb(j) Then
            p = p + 1
            c(p) = ra(i)
        End If
     Next i
Next j
For i = 1 To na
    For j = 1 To nb
        If ra(i) = rb(j) Then GoTo nxti
    Next j
    p = p + 1
    c(p) = ra(i)
    ra(i) = Empty
nxti: Next i
For i = 1 To na
    If Not IsEmpty(ra(i)) Then
        q = q + 1
        For j = 1 To ma
            a(q, j) = a(i, j)
        Next j
    End If
Next i
Sheets("A").UsedRange.ClearContents
Sheets("A").[a1].Resize(q, ma) = a
Sheets("B").UsedRange.ClearContents
For i = 1 To p
    Sheets("B").Cells(i, 1).Resize(1, mb) = Split(c(i), Chr(30))
Next i
End Sub

Ha det

 

[stigvage]

Thanks rugila!

It works nicely.

If I want the code to compare columns, say A to F even if there are further columns, how do I modify the code?

Stig

 

[Legacy 14611]

OK.
Test this one to see if it's what you want.

Sub rowsandstuffrev()
Dim a, b, c(), ra(), rb(), p, q, z
a = Sheets("A").UsedRange
b = Sheets("B").UsedRange
na = UBound(a, 1): ma = UBound(a, 2)
nb = UBound(b, 1): mb = UBound(b, 2)
ReDim ra(1 To na), rb(1 To nb), c(1 To na, 1 To ma)
z = 6   'or whatever column number you want comparison to be up to.
If z > ma Or z > mb Then
    MsgBox "Trying to compare more columns than are available." _
        & Chr(10) & "Exiting code."
    Exit Sub
End If
    
For i = 1 To na
    For j = 1 To z
        If j = 1 Then
            ra(i) = a(i, j)
        Else: ra(i) = ra(i) & Chr(30) & a(i, j)
        End If
Next j, i

For i = 1 To nb
    For j = 1 To z
        If j = 1 Then
            rb(i) = b(i, j)
        Else: rb(i) = rb(i) & Chr(30) & b(i, j)
        End If
Next j, i

For j = 1 To nb
    For i = 1 To na
        If ra(i) = rb(j) Then
            p = p + 1
            For k = 1 To ma
                c(p, k) = a(i, k)
            Next k
        End If
     Next i
Next j

For i = 1 To na
    For j = 1 To nb
        If ra(i) = rb(j) Then GoTo nxti
    Next j
    p = p + 1
        For k = 1 To ma
            c(p, k) = a(i, k)
        Next k
    ra(i) = Empty
nxti: Next i

For i = 1 To na
    If Not IsEmpty(ra(i)) Then
        q = q + 1
        For j = 1 To ma
            a(q, j) = a(i, j)
        Next j
    End If
Next i

Sheets("A").UsedRange.ClearContents
Sheets("B").UsedRange.ClearContents
Sheets("A").[a1].Resize(q, ma) = a
Sheets("B").[a1].Resize(p, mb) = c
End Sub

 

[stigvage]

Thanks again.

Stig

Takker og bukker