Match and delete rows on two different sheets from reference numbers

[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

 

[Claus Busch]

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.

 

[Colin Hayes]

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

 

[Claus Busch]

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.

 

[Colin Hayes]

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