Match value in two columns & delete non-matching rows

[araarso]

Hello
I am a new to the VBA, but familiar with VBA.NET, but could not figured out this:
If a value of cell in Column "A" does not match any of the value in Column "D", I want to delete entire row. So in the sample sheet, all rows must be deleted except Row 2 and 7. Or, moved the matches to different sheet..

Thank you,
Abdi J.

[Sisyphus]

If you delete the entire rows, you would also be deleting the values in column D. Did you want to do that?

[araarso]

That is correct, Sisyphus

[Sisyphus]

A couple more questions, just to clarify your problem:

1. Assuming you begin at the top and work your way down, once you detect a non-match condition and delete that row, the column D value would not be available for matching to subsequent rows. Is that the condition you want? For example, if cell A3 were 95, once row 2 is deleted, the next row would become a non-match because the 95 in row 2 has now been removed from the list.

2. Will column D be always pre-sorted in ascending order. as it is here?

[araarso]

Sisyphus,
If the cell in the column "D" is found a matching value in Column "A", then there is no any other matches since there is only one match for each cell in column "D" against Column "A".

Yes, it is pre-sored in Ascending order.

[mdmackillop]

As Sisyphus says, what about this scenario?

[araarso]

I see.
Just want to rephrase the desired outcome, I need to be able to search each cell value in Column "D" and see if there is any matching cell in Column "A" -- so I am not only looking to see if there is a match in column "A" and column "D" in a same row. For instance, in Sisyphus's scenario, when "D2" is matched, I only need the matched row (without Column D) to be copied to new sheet.

I hope that explains....I appreciate that you are trying to help.

[Sisyphus]

That wasn't quite my question, but I think the following code should work for you. Change "Sheet1" to whatever your worksheet name is.


Sub DelNonMatch()

Dim RowNo, LastRow As Integer

RowNo = 2
LastRow = Cells.SpecialCells(xlCellTypeLastCell).Row

'Next line is needed to handle non-match conditions with Match function
On Error Resume Next

Worksheets("Sheet1").Activate
For RowNo = 2 To LastRow
'Flag rows with matches
Cells(RowNo, 5) = IsError(Application.WorksheetFunction.Match(Cells(RowNo, 1), Range(Cells(2, 4), Cells(LastRow, 4)), 1))
Next

RowNo = 2
Do While IsEmpty(Cells(RowNo, 1)) = False
If Cells(RowNo, 5) = "False" Then
Cells(RowNo, 5) = "" 'Clean-up cell
RowNo = RowNo + 1
Else
Rows(RowNo).Select
Selection.Delete Shift:=xlUp
End If
Loop

End Sub

[Aussiebear]

Does the data ever get refreshed? (As in added to or amended). Why not consider hiding the non matching rows?

[mikerickson]

This avoids looping.
Sub test()
Dim helperCells As Range
With ThisWorkbook.Sheets("sheet1"): Rem adjust
With .UsedRange
Set helperCells = .Cells(1, .Columns.Count + 2).EntireColumn
End With
Set helperCells = Application.Intersect(Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)).EntireRow, helperCells)
End With

With helperCells
.FormulaR1C1 = "=IF(RC1=RC4,11)"
On Error Resume Next
.SpecialCells(xlCellTypeFormulas, xlLogical).EntireRow.Delete
.Delete: Rem clean-up helper column
On Error GoTo 0
End With
End Sub

[araarso]

Hi Sisyphus,
Your code works with the previous test data, but when I tried to run that on a list with more columns & rows, it basically stops running after it finds the first one. I had to change your code little bit to match the columns for the new spreadsheet. Please see the sample attached.

I really appreciate your help.

Sub DelNonMatch()

Dim RowNo, LastRow As Integer

RowNo = 2
LastRow = Cells.SpecialCells(xlCellTypeLastCell).Row

'Next line is needed to handle non-match conditions with Match function
On Error Resume Next

Worksheets("Sheet1").Activate
'stop screen update showing up
Application.ScreenUpdating = False

For RowNo = 2 To LastRow
'Flag rows with matches
Cells(RowNo, 10) = IsError(Application.WorksheetFunction.Match(Cells(RowNo, 1), Range(Cells(2, 9), Cells(LastRow, 9)), 1))
Next

RowNo = 2
Do While IsEmpty(Cells(RowNo, 1)) = False
If Cells(RowNo, 10) = "False" Then
Cells(RowNo, 10) = "" 'Clean-up cell
RowNo = RowNo + 1
Else
Rows(RowNo).Select
Selection.Delete Shift:=xlUp
End If
Loop
'Display screen update showing up
Application.ScreenUpdating = True

End Sub

[araarso]

Hi Mikerickson,

This avoids looping.

When I tried your code, it completely deleted without even matching single record.

Thanks for the help.

[Sisyphus]

OK, I presumed that your spreadsheet was always going to formatted as in your sample data. You could make it more flexible by testing the used range to see how many columns there are, then replace the fixed column indices with a variable.

[araarso]

Sisyphus,
I am newbie in Excel VBA so I tried to make as little changes as possible since your code worked with the sample. So where you had Range(Cells(2, 4), I changed it to Range(Cells(2, 10), . Also where you had Range(Cells(2, 5), I changed to Range(Cells(2, 10), . I thought that would do the trick, but I am not able to make it to work.

Thanks for the help again.