Match and delete rows on two different sheets from reference numbers

  • Thread starter Thread starter Colin Hayes
  • Start date Start date
C

Colin Hayes

HI All

I have a little problem I need to solve with Excel.

In sheet1 in column A I have rows of reference numbers.

In sheet 2 in columns A I have equally rows of reference numbers , some
of which match those reference numbers in sheet 1 , and some don't.

I need help with a macro to delete the rows in Sheet 1 which don't have
corresponding reference numbers in sheet 2.

So for example - BEFORE

Sheet 1

A

1
2
3
4
5
6
7
8
9
10

Sheet 2

A

3
5
7

AFTER

Sheet 1

A

3
5
7

Only rows with references 3 5 & 7 remain in sheet 1 , as these were the
only ones which match the reference numbers in sheet 2. The other rows
were deleted from sheet 1.

Grateful for any help.



Best Wishes
 
Hi Colin,

Am Tue, 6 Aug 2013 16:57:47 +0100 schrieb Colin Hayes:
Only rows with references 3 5 & 7 remain in sheet 1 , as these were the
only ones which match the reference numbers in sheet 2. The other rows
were deleted from sheet 1.

try:
Sub DeleteRows()
Dim LRow As Long
Dim LRow2 As Long
Dim i As Long

LRow2 = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
With Sheets("Sheet1")
LRow = .Cells(.Rows.Count, 1).End(xlUp).Row
For i = LRow To 1 Step -1
If WorksheetFunction.CountIf(Sheets("Sheet2") _
.Range("A1:A" & LRow2), .Cells(i, 1)) = 0 Then
.Rows(i).Delete
End If
Next
End With
End Sub


Regards
Claus B.
 
Claus Busch said:
Sub DeleteRows()
Dim LRow As Long
Dim LRow2 As Long
Dim i As Long

LRow2 = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row With
Sheets("Sheet1")
LRow = .Cells(.Rows.Count, 1).End(xlUp).Row
For i = LRow To 1 Step -1
If WorksheetFunction.CountIf(Sheets("Sheet2") _
.Range("A1:A" & LRow2), .Cells(i, 1)) = 0 Then
.Rows(i).Delete
End If
Next
End With
End Sub

Hi Claus

OK this works perfectly - thank you.

BTW I see that altering 0 to 1 in the line

If WorksheetFunction.CountIf(Sheets("Sheet2") _
Range("A1:A" & LRow2), .Cells(i, 1)) = 0 Then.Rows(i).Delete

gives the reverse function.

Would it be possible to build in a popup message box so the user can
enter 0 or 1 to get the action required?



Best Wishes
 
Hi Colin,

Am Wed, 7 Aug 2013 00:41:39 +0100 schrieb Colin Hayes:

BTW I see that altering 0 to 1 in the line

if you are deleting rows from top the rows below shift up. And the
counter is not working properly.
Would it be possible to build in a popup message box so the user can
enter 0 or 1 to get the action required?

Is that what you want?

Sub DeleteRows()
Dim LRow As Long
Dim LRow2 As Long
Dim i As Long
Dim ans As Integer

ans = MsgBox("Do you really want to delete the rows", _
vbOKCancel + vbInformation, "Safety check")

If ans = vbOK Then
LRow2 = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
With Sheets("Sheet1")
LRow = .Cells(.Rows.Count, 1).End(xlUp).Row
For i = LRow To 1 Step -1
If WorksheetFunction.CountIf(Sheets("Sheet2") _
.Range("A1:A" & LRow2), .Cells(i, 1)) = 0 Then
.Rows(i).Delete
End If
Next
End With
End If
End Sub


Regards
Claus B.
 
Is that what you want?
Sub DeleteRows()
Dim LRow As Long
Dim LRow2 As Long
Dim i As Long
Dim ans As Integer

ans = MsgBox("Do you really want to delete the rows", _
vbOKCancel + vbInformation, "Safety check")

If ans = vbOK Then
LRow2 = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
With Sheets("Sheet1")
LRow = .Cells(.Rows.Count, 1).End(xlUp).Row
For i = LRow To 1 Step -1
If WorksheetFunction.CountIf(Sheets("Sheet2") _
.Range("A1:A" & LRow2), .Cells(i, 1)) = 0 Then
.Rows(i).Delete
End If
Next
End With
End If
End Sub


Regards
Claus B.


Hi Claus

Yes , that's fine. Thanks very much for your help,



Best Wishes
 
Back
Top