Home > Net >  How can we compare two columns and copy differences from Sheet2 to Sheet1?
How can we compare two columns and copy differences from Sheet2 to Sheet1?

Time:03-09

I have two ranges on two sheets.

enter image description here

enter image description here

I am trying to compare these two lists for differences, and copy any differences from Sheet2 to Sheet1. Here is my code. I think it's close, but something is off, because all if does is delete row 14 on Sheet1 and no different cells from Sheet2 are copied to Sheet1. What's wrong here?

Sub Compare()

Dim lastRow1 As Integer
Dim lastRow2 As Integer
Dim foundTrue As Boolean

lastRow1 = Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count, "A").End(xlUp).Row
lastRow2 = Sheets("Sheet2").Cells(Sheets("Sheet2").Rows.Count, "E").End(xlUp).Row

For i = 2 To lastRow2
foundTrue = False
For j = 2 To lastRow1
    If Sheets("Sheet2").Cells(i, 1).Value = Sheets("Sheet1").Cells(j, 1).Value Then
        foundTrue = True
        Exit For
    End If
Next j

If Not foundTrue Then
    Sheets("Sheet2").Cells(i).Copy Destination:=Sheets("Sheet1").Rows(lastRow1 - 1)
End If

Next i
Debug.Print i

End Sub

I want to end up with this.

enter image description here

CodePudding user response:

Nothing that a debug session can't reveal.

You need to copy to lastrow 1, not lastrow - 1.

After copying the first value, you need to somehow increase the value for lastRow1. But as you use this value as limit in your (inner) for-loop, you shouldn't modify it. So I suggest you introduce a counter variable that counts how many rows you already copied and use this as offset.

And you have some more mistakes:
Your data in sheet2 is in columns E and F, but you compare the values of column "A" (you wrote Sheets("Sheet2").Cells(i, 1).Value)

The source in your copy-command accesses is .Cells(i). In case i is 10, this would be the 10th cell of your sheet, that is J1 - not the cell E10. And even if it was the correct cell, you would copy only one cell, not two.

Obgligatory extra hints: Use Option Explicit (your variables i and j are not declared), and always use Long, not Integer.

Code could look like (I renamed foundTrue because it hurts my eyes to see True in a variable name)

Dim i As Long, j As Long
For i = 2 To lastRow2
    foundValue = False
    For j = 2 To lastRow1
        If Sheets("Sheet2").Cells(i, 5).Value = Sheets("Sheet1").Cells(j, 1).Value Then
            foundValue = True
            Exit For
        End If
    Next j
    
    If Not foundValue Then
        addedRows = addedRows   1
        Sheets("Sheet2").Cells(i, 5).Resize(1, 2).Copy Destination:=Sheets("Sheet1").Cells(lastRow1, 1).Offset(addedRows)
    End If
Next i

But this leaves a lot room for improvement. I suggest you have a look to the following, in my eyes it's much cleaner and much more easy to adapt. There is still room for optimization (for example read the data into arrays to speed up execution), but that's a different story.

Sub Compare()

    Const sourceCol = "E"
    Const destCol = "A"
    Const colCount = 2
    
    ' Set worksheets
    Dim sourceWs As Worksheet, destWs As Worksheet
    Set sourceWs = ThisWorkbook.Sheets("Sheet2")
    Set destWs = ThisWorkbook.Sheets("Sheet1")
    
    ' Count rows
    Dim lastRowSource As Long, lastRowDest As Long
    lastRowSource = sourceWs.Cells(sourceWs.Rows.Count, sourceCol).End(xlUp).Row
    lastRowDest = destWs.Cells(destWs.Rows.Count, destCol).End(xlUp).Row
    
    Dim sourceRow As Long, destRow As Long
    Dim addedRows As Long
    For sourceRow = 2 To lastRowSource
        Dim foundValue As Boolean
        foundValue = False
        For destRow = 2 To lastRowDest
            If sourceWs.Cells(sourceRow, sourceCol).Value = destWs.Cells(destRow, destCol).Value Then
                foundValue = True
                Exit For
            End If
        Next destRow
        
        If Not foundValue Then
            addedRows = addedRows   1
            sourceWs.Cells(sourceRow, sourceCol).Resize(1, colCount).Copy Destination:=destWs.Cells(lastRowDest, 1).Offset(addedRows)
        End If
    Next sourceRow

End Sub

CodePudding user response:

Copy Differences (Loop)

A Quick Fix

Option Explicit

Sub Compare()
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim ws1 As Worksheet: Set ws1 = wb.Worksheets("Sheet1")
    Dim lRow1 As Long: lRow1 = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
    Dim fRow1 As Long: fRow1 = lRow1
    
    Dim ws2 As Worksheet: Set ws2 = wb.Worksheets("Sheet2")
    Dim lRow2 As Long: lRow2 = ws2.Cells(ws2.Rows.Count, "E").End(xlUp).Row
    
    Dim i As Long, j As Long
    
    For i = 2 To lRow2
        
        For j = 2 To lRow1
            If ws2.Cells(i, "E").Value = ws1.Cells(j, "A").Value Then Exit For
        Next j
    
        ' Note this possibility utilizing the behavior of the For...Next loop.
        ' No boolean necessary.
        If j > lRow1 Then ' not found
            fRow1 = fRow1   1
            ws2.Cells(i, "E").Resize(, 2).Copy ws1.Cells(fRow1, "A")
        End If
        
    Next i
    
    MsgBox "Found " & fRow1 - lRow1 & " differences.", vbInformation

End Sub
  • Related