VBA Delete rows of matching data

Question

I built a macro that transfers 2 csv files of data on sheet 1 and sheet 2 and renames those 2 sheets. I want to build another macro that will copy all non-matching rows in between the 2 sets of data into a new xlsx file. To identify matching data, I need to write something that will do this:

If a cell value of column A in sheet1 has a matching value in column A of sheet2, then I need to compare for the corresponding rows on each sheet: Column B of sheet1 to Column C of sheet2, Column D of sheet1 to Column E of sheet2, Column F of sheet1 to Column G of sheet2, Column G of sheet1 to Column H of sheet2, Column H of sheet1 to Column I of sheet2, Column J of sheet1 to Column J of sheet2 and copy all rows of data in sheet1 that do not have matching rows in sheet2 into a new file.

Here is a draft of my code:

Sub SupprLignes()
Dim rowCount1 As Long, rowCount2 As Long
Dim rng1 As Range, rng2 As Range, MyCell As Range, Mycell2 As Range
Dim currentRow As Long
Dim WB As Workbook
Dim WS As Worksheet

Set WB = Workbooks.Add

ActiveWorkbook.SaveAs "C:\Users\Phil\Desktop _
\Report_" & Format(Date, "dd-mm-yyyy") & ".xlsx"

rowCount1 = Workbooks("Received_temp.xlsx").Worksheets _
("Received").Range("A2").SpecialCells(xlCellTypeLastCell).Row

Set rng1 = Workbooks("Received_temp.xlsx").Worksheets _
("Received").Range("A2:A" & rowCount1)

rowCount2 = Workbooks("Received_temp.xlsx").Worksheets _
("NotReceived").Range("A2").SpecialCells(xlCellTypeLastCell).Row
Set rng2 = Workbooks("Received.xlsx").Worksheets _
("NotReceived").Range("A2:A" & rowCount2)

Dim sheet1() As Variant
ReDim sheet1(rowCount1 - 1, 2)

currentRow = 0

For Each MyCell In rng1.Cells
    For Each Mycell2 In rng2.Cells
        If Mycell2.Value = MyCell.Value And Mycell2.Offset(0, 5).Value = _
MyCell.Offset(0, 5).Value And Mycell2.Offset(0, 2).Value = _
MyCell.Offset(0, 2).Value Then

            Workbooks("Received_temp.xlsx").Worksheets _
("Received").Rows(Cell.Row).Copy
                Destination:=Workbooks("Received.xlsx").Worksheets _
("Received").Range("A" & currentRow)

            currentRow = currentRow + 1

            GoTo NextIteration
        End If
    Next cell2
Next Cell

NextIteration:
ThisWorkbook.Sheets(1).Rows(Cell.Row).Copy Destination:=ThisWorkbook.Sheets(4).Range("A" & currentRow)

End Sub

I know the For Next is wrong but I knew I was not in the right direction so I let it like that for the moment.

What is your code doing that it shouldn't be doing, or failing to do that you want it to do? As a first look, I don't think the For Each... Next loops are necessarily the wrong way to go about this; the place I'd have a question is about the GoTo NextIteration. If you replaced that with an Exit For instead, you'd stop looking at "this" cell from Rng1 compared to everything in Rng2, and continue looking at the rest of the cells from Rng1. See if that does good things for you, and let us know where things are going astray from what you want. — Ralph J
At any rate, you should replace Next cell2 and Next Cell with Next. — Wiktor Stribiżew

rgo rgo · Accepted Answer · 2015-03-10T01:13:43

For starters add a column to the worksheet and insert the Match function. This will tell you the row number of the corresponding search value. #N/A's will appear for the non-matching rows. You can automate populating the Match column by using the macro recorder to save the formulas in RC format, then copy them down to the bottom of the sheet.

Now loop through the match row column looking for the #N/A's

Example:

Dim aCell as range
Dim aRange as range
dim tWS as worksheet
dim lrow as long

Application.calculation = xlmanual
set tWS = thisworkbook.sheets("Sheet2")  '*** Target worksheet to copy not founds

set arange = intersect(activesheet.range("A1"), activesheet.usedrange)
for each acell in arange
   if isnull(acell) then
     lrow = tws.range("A65536").end(xlup).row + 1
    copy acell.entirerow tws.range("A" & Lrow)
   endif
next acell
application.calculation = xlAutomatic

When done you can copy the TWS to another workbook, which is easier than linking to a new workbook and appending one record at a time.

VBA Delete rows of matching data

1 Answers