I have two ranges on two sheets.
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.
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