Hi all,
I need vba code to compare sheet1 with sheet2, if values are the same in column A,B,C of both sheets then delete the row in sheet2.
Sheet1 and sheet2 have different amount of rows.
Thank you in advance.
Hi all,
I need vba code to compare sheet1 with sheet2, if values are the same in column A,B,C of both sheets then delete the row in sheet2.
Sheet1 and sheet2 have different amount of rows.
Thank you in advance.
Re: Compare 2 sheets, delete rows on one sheet based on 3 columns
If I understood you correctly, if column A in sheet 1 matches column A in sheet 2, and column B matches Column B and column C matches column C then delete that row in sheet 2? And you would like to check every record in sheet 1 against every record in sheet 2? If so this will work:
Sub xldummy()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim Start1 As Long
Dim Start2 As Long
Dim Lrow1 As Long
Dim Lrow2 As Long
Set ws1 = Sheets("Sheet1") 'Change Sheet Name
Set ws2 = Sheets("Sheet2") 'Change Sheet Name
Lrow1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row 'Last Row of sheet 1
Lrow2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row 'Last Row of sheet 2
For Start1 = 2 To Lrow1 'Loop to check every record in Sheet 1 starting in row 2
For Start2 = 2 To Lrow2 'Loop to check each record in sheet 1 against sheet 2 starting in row 2
If ws1.Cells(Start1, 1) = ws2.Cells(Start2, 1) And ws1.Cells(Start1, 2) = ws2.Cells(Start2, 2) And ws1.Cells(Start1, 3) = ws2.Cells(Start2, 3) Then 'If each column on sheet 1 matches the respective column on sheet 2 then clear contents of sheet two's row.
ws2.Range(Cells(Start2, 1), Cells(Start2, 3)).ClearContents
End If
Next Start2
Next Start1
On Error Resume Next
ws2.Range("A2:A" & Lrow2).SpecialCells(xlCellTypeBlanks).EntireRow.Delete 'Deletes all blank rows within your data set.
End Sub
Display More
Re: Compare 2 sheets, delete rows on one sheet based on 3 columns
Hi xldummy,
The following macro will delete any row from Sheet2 where columns A, B and C of any row are in Sheet1:
Option Explicit
Sub Macro1()
Const lngStartRow As Long = 2 'Starting row number for the data in Sheet2. Change to suit if necessary.
Dim lngHelperCol As Long, _
lngMyRow As Long, _
lngLastRowSht1 As Long, _
lngLastRowSht2 As Long
Dim xlnCalcMethod As XlCalculation
With Application
xlnCalcMethod = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
lngLastRowSht1 = Sheets("Sheet1").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
lngHelperCol = Sheets("Sheet2").Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
lngLastRowSht2 = Sheets("Sheet2").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For lngMyRow = lngLastRowSht2 To lngStartRow Step -1
With Sheets("Sheet2").Cells(lngMyRow, lngHelperCol)
'Array formula to check for multiple columns was based from here: http://www.excel-easy.com/examples/two-column-lookup.html
.FormulaArray = "=MATCH(A" & lngMyRow & "&B" & lngMyRow & "&C" & lngMyRow & ",Sheet1!A" & lngStartRow & ":A" & lngLastRowSht1 & "&Sheet1!B" & lngStartRow & ":B" & lngLastRowSht1 & "&Sheet1!C" & lngStartRow & ":C" & lngLastRowSht1 & ",0)"
.Value = .Value
End With
'If there array has returned the matching row number from Sheet1, then...
If IsError(Sheets("Sheet2").Cells(lngMyRow, lngHelperCol)) = False Then
'...delete that row.
Sheets("Sheet2").Rows(lngMyRow).Delete
'Else...
Else
'...just remove the array formula.
Sheets("Sheet2").Cells(lngMyRow, lngHelperCol).ClearContents
End If
Next lngMyRow
With Application
.Calculation = xlnCalcMethod
.ScreenUpdating = True
End With
MsgBox "All rows in Sheet2 where columns A to C where in Sheet1 have now been deleted.", vbInformation
End Sub
Display More
Just make sure to initially run the code on a copy of your data as the results cannot be undone if they're not as expected.
Regards,
Robert
Re: Compare 2 sheets, delete rows on one sheet based on 3 columns
Thank you both Max1616 and Trebor76.
Both subs work fine.
Regards,
xldummy
Re: Compare 2 sheets, delete rows on one sheet based on 3 columns
If you have a large data set the using an array based code rather than object based should be much faster, try this:
Sub RowDeletion()
Dim x, y, i As Long
x = Sheets("sheet2").Cells(1).CurrentRegion 'CHANGE SHEET NAME TO SUIT
ReDim y(1 To UBound(x, 1) - 1)
For i = 2 To UBound(x, 1)
y(i - 1) = x(i, 1) & x(i, 2) & x(i, 3)
Next
With Sheets("sheet3") 'CHANGE SHEET NAME TO SUIT
x = .Cells(1).CurrentRegion
For i = 2 To UBound(x, 1)
If Not IsError(Application.Match(x(i, 1) & x(i, 2) & x(i, 3), y, 0)) Then x(i, 1) = Empty
Next
.Cells(1).CurrentRegion = x
.Columns(1).SpecialCells(4).EntireRow.Delete
End With
End Sub
Display More
Assumes row 1 for both sheets is a header row and data starts in row 2.
Re: Compare 2 sheets, delete rows on one sheet based on 3 columns
Thank you KjBox,
I do not have a large data base but your solution is so clever.
Thanks.
Don’t have an account yet? Register yourself now and be a part of our community!