Hi again Brett,
Didn’t wait for your answer. Decided to run with what I interpreted as your
requirements and give it to you and if not right then I can modify it.
Firstly ensure that you have a backup of your data in case the macro does
not do what you expect.
I have written the macro so that instead of initially deleting the rows, it
will colour the rows yellow. That will give you the opportunity to check a
reasonable sample to ensure it is going to delete the correct rows. When you
are satisfied that it is correct, simply comment out the colorindex line and
remove the comment (single quote) from the delete line.
Before running the macro, you will need to select the 1000 or so data from
the first to last cell of the range required. (Not the entire column).
At the Input box prompt, select the second range of 100 or so. (If you
wanted to select the other way around then I can change it later but run with
this first and test if it achieves what you want to do.)
Processing will terminate if you Cancel in the Input box.
I tried to keep the code as simple as possible to give you the opportunity
to try to understand what it is all doing. Feel free to ask questions about
any of it that you do not understand and I will try to explain.
If the macro does not do what you want then please answer the questions on
my previous 2 posts and I will attempt to correct it.
Sub DelUnmatchedRows()
Dim rng1 As Range 'Initial selection
Dim rng2 As Range 'InputBox selection entry
Dim i As Long 'In For/Next Loop
Dim foundcell As Range 'Returned in Find function
'Your Selection prior to running macro
'Assign selection to a variable
Set rng1 = Selection
'Test that selection is minimun 2 cells
'and only one column wide. (Not multiple columns)
If rng1.Cells.Count < 2 Or rng1.Columns.Count <> 1 Then
MsgBox "Invalid range selection." & Chr(13) & _
"Select multiple cells in one column only" _
& Chr(13) & "Processing will terminate"
Exit Sub
End If
On Error Resume Next
Set rng2 = Application.InputBox(Prompt:= _
"Please select a range with your Mouse.", _
Title:="SPECIFY RANGE", Type:=8)
On Error GoTo 0
'If user cancels in the Input Box
If rng2 Is Nothing Then
MsgBox "User cancelled" _
& Chr(13) & "Processing will terminate"
Exit Sub
End If
Application.ScreenUpdating = False
'Test that selection is minimun 2 cells
'and only one column wide.
If rng2.Cells.Count < 2 Or rng2.Columns.Count <> 1 Then
MsgBox "Invalid range selection." & Chr(13) & _
"Select multiple cells in one column only" _
& Chr(13) & "Processing will terminate"
Exit Sub
End If
'Loop through each cell in rng1 and
'find the value in rng2.
'When deleting rows, must work backwards
'from last row. Otherwise adjacent rows
'do not delete.
For i = rng1.Rows.Count To 1 Step -1
Set foundcell = rng2. _
Find(What:=rng1.Cells(i, 1).Value, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
'If not found in rng2 then delete row
If foundcell Is Nothing Then
'After testing, comment out colorindex line
'and remove comment from delete line.
rng1.Cells(i, 1).EntireRow.Interior.ColorIndex = 6
'rng1.Cells(i, 1).EntireRow.Delete
End If
Next i
Application.Goto Range("A1"), scroll:=True
Application.ScreenUpdating = True
End Sub
Regards,
OssieMac
