CODEWITHSUNDEEP
excelvbafor-loopcomparerange
Juan
Juan

Reputation: 311

Compare two data ranges and copy entire row into worksheet VBA

i have found many very similar questions in the forum, but somehow nothing fits what i am looking for. I have two ranges (a & b) which i'd like to compare and if values do not match, i'd like to copy the entire row to a predefined worksheet. The purpose is to find rows / values that have been changed vs. previous edit.

Dim a, b as range
Dim ws1,ws2,ws3 as worksheet
Dim last_row, last_row2 as integer 'assume last_row =15, last_row2=12
Dim i, j, k as integer
last_row=15
last_row2=12
' the orignal range is not massive, but at 500x 6 not small either
Set a=ws1.range("I5:S"& last_row)
Set b=ws2.range("H2:R"& last_row2)

I have seen different approaches when it comes to addressing each item of the range and don't know which would be quickest / best (loop or for each ). The main if-statement would look something like this:

'assume i, j are the used as counters running across the range
k = 1
If Not a(i).value=b(j).value then
a(i)EntireRow.copy
ws3.row(k).paste
k = k + 1
end if

The solution cannot be formula based, as I need to have ws3 saved after each comparison. Any help on this is much appreciated. Thanks!

Upvotes: 0

Views: 66

Answers (2)

Juan
Juan

Reputation: 311

This is the small for-loop I ended up using. Thanks for your input!

For i = 1 To rOutput.Cells.Count
    If Not rOutput.Cells(i) = rBackUp.Cells(i) Then
'    Debug.Print range1.Cells(i)
'    Debug.Print range2.Cells(i)
    rOutput.Cells(i).EntireRow.Copy wsChangeLog.Rows(k)
    
    k = k + 1
    End If
Next i

Upvotes: 0

pgSystemTester
pgSystemTester

Reputation: 9917

If you have the ability to leverage Excel Spill Ranges, you can achieve what you want without VBA. Here's a web Excel file that shows all rows in first sheet where column A does not equal column b.

=FILTER(Sheet1!A:ZZ,Sheet1!A:A<>Sheet1!B:B)

If VBA is required, this routine should work. It's not optimal for handling values (doesn't use an array), but it gets it done.

Sub listDifferences()
Dim pullWS As Worksheet, pushWS As Worksheet

Set pullWS = Sheets("Sheet1")
Set pushWS = Sheets("Sheet2")

Dim aCell As Range

For Each aCell In Intersect(pullWS.Range("A:A"), pullWS.UsedRange).Cells
    
    If aCell.Value <> aCell.Offset(0, 1).Value Then
        Dim lastRow As Long
        lastRow = pushWS.Cells(Rows.Count, 1).End(xlUp).Row
        pushWS.Rows(lastRow + 1).Value = aCell.EntireRow.Value
    End If
Next aCell

End Sub

Upvotes: 1

Related Questions