Compare 2 columns and remove matching duplicates in both columns when found

[dtms1]

Okay so I have an example excel sheet where my data can move (but always relative from the active cell in this example it's B2)

I tried making a code where it matches data in another column and I want it to remove adjacent rows in BOTH columns where a value exist the two columns im looking at.
I have made the code below


Sub dontcareforsimilarValues()
nr = ActiveCell.Row
nc = ActiveCell.Column
nrEND = Cells(Rows.Count, nc).End(xlUp).Row
For i = nr To nrEND
If IsNumeric(Application.Match(Cells(i, nc).Value, Columns(nc + 6), 0)) Then
Range(Cells(i, nc - 1), Cells(i, nc + 2)).Delete Shift:=xlUp
i = i - 1
End If
Next i
End Sub
But what I found out is now I can't use that same code I made on the other column because of the already removed values.
Now im thinking for a way to store values that were found matching and at the end delete that value (and its associated rows) on both columns but found my self stuck.

Any ideas?

[mikerickson]

Try this. It doesn't delete until the cells from both ranges have been identified.

Sub aTest()
Dim aColumnOfInterest As Range, bColumnOfInterest As Range
Dim aRemove As Range, bRemove As Range
Dim oneCell As Range

Rem set columns of interest
With Sheet3
With .Range("B:B")
Set aColumnOfInterest = Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp))
End With

With .Range("H:H")
Set bColumnOfInterest = Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp))
End With
End With

Rem find cells in aCol to delete
Set aRemove = aColumnOfInterest.Cells(1, 2)
For Each oneCell In aColumnOfInterest
If IsNumeric(Application.Match(oneCell.Value, bColumnOfInterest, 0)) Then
Set aRemove = Application.Union(oneCell, aRemove)
End If
Next oneCell
Set aRemove = Application.Intersect(aRemove, aColumnOfInterest)

Rem find cells in bCol to delete
Set bRemove = bColumnOfInterest.Cells(1, 2)
For Each oneCell In bColumnOfInterest
If IsNumeric(Application.Match(oneCell.Value, aColumnOfInterest, 0)) Then
Set bRemove = Application.Union(oneCell, bRemove)
End If
Next oneCell
Set bRemove = Application.Intersect(bRemove, bColumnOfInterest)

On Error Resume Next
Application.Intersect(aColumnOfInterest.CurrentRegion, aRemove.EntireRow).Delete shift:=xlUp
Application.Intersect(bColumnOfInterest.CurrentRegion, bRemove.EntireRow).Delete shift:=xlUp
On Error Goto 0
End Sub

[dtms1]

Try this. It doesn't delete until the cells from both ranges have been identified.


That's interesting mikerickson, it worked (with a limitation that the first selected active cell from the top can't be a unique value otherwise it will delete it even though there is no match, but thats minor). I modified it to reflect locations relative to active cell as initially attempted.

Sub aTest22()
nr = ActiveCell.Row
nc = ActiveCell.Column
nrEND = Cells(Rows.Count, nc).End(xlUp).Row

Set aColumnOfInterest = Range(Cells(nr, nc), Cells(nrEND, nc))
Set bColumnOfInterest = Range(Cells(nr, nc + 6), Cells(nrEND, nc + 6))

Rem find cells In aCol To delete
Set aRemove = aColumnOfInterest.Cells(1, 1)
For Each Cell In aColumnOfInterest
If IsNumeric(Application.Match(Cell, bColumnOfInterest, 0)) Then
Set aRemove = Application.Union(Cell, aRemove)
End If
Next Cell

Rem find cells In bCol To delete
Set bRemove = bColumnOfInterest.Cells(1, 1)
For Each Cell In bColumnOfInterest
If IsNumeric(Application.Match(Cell.Value, aColumnOfInterest, 0)) Then
Set bRemove = Application.Union(Cell, bRemove)
End If
Next Cell

'On Error Resume Next
Application.Intersect(aColumnOfInterest.CurrentRegion, aRemove.EntireRow).Delete shift:=xlUp
Application.Intersect(bColumnOfInterest.CurrentRegion, bRemove.EntireRow).Delete shift:=xlUp
'On Error GoTo 0

End Sub

Thank You mikerickson
However, what's more important I was trying to follow the logic to understand and learn a little bit more.
So I'm able to follow up until you introduce the aRemove (i tried to do a step into step by step but the local window was showing a lot of irrelevant types and values for the aRemove).
Please correct me if I'm wrong in any of the below assumptions/understanding, but I think it's like this:
When you introduce aRemove you are setting it to one unique value (like a value in one cell).
Then with the union one by one each time the if statement is true, you are now adding the current/active cell in the loop to the aRemove by the union function

Now whats confusing for me is the intersect of the two ranges
The way I'm thinking about it is visually with a location reference to cells in the sheet. When you do the application.intersect of aRemove and aColumnOfInterest, I have trouble seeing how vba will know the intersection of aRemove. Because we started with one cell and added values to it by union, but with the union it didnt seem like we specify a location, so how does aColumnofInterest know where it's intersecting with aRemove?
To me, the intersect is almost like a match function, reguardless of location in the two ranges its considered intersection if same values are present in each range?


So then in the last portion during deletion. I think that current region trick is neat. But how will current region handle spaces in there are any between rows? Is there another selection option to use?
And lastly why are the error handlers there? and why go to 0 when there is no 0?


Thank You

[mikerickson]

The basic idea is
1) Go through the first range, looking for cells that are duplicated in the second range.
2) When a cell like that is found, then add it to the variable aRemove.

3,4) Do the same for the second range and bRemove

5) Delete aRemove and bRemove.

The aRemove coding is complicated because Union errors when Nothing is one of the arguments. My approach is to initialize aRange with a cell that is outside the range being searched. Then add the found cells. Then remove that initial cell.


Set aRemove = Range("B1")

For Each oneCell in Range("A1:A1000")
If oneCell meets condition then
Set aRemove = Application.Union(aRange, oneCell)
End If
Next oneCell

Set aRemove = Application.Intersect(aRemove, Range("A:A"))

Another approach would be to test if aRemove is Empty


For each oneCell in Range("A1:A1000")
If oneCell meets condition Then
If aRemove Is Nothing Then
Set aRemove = oneCell
Else
Set aRemove = Application.Union(aRemove, oneCell)
End If
End If
Next oneCellI don't like the second approach because the time hit that the "If aRemove Is Nothing ... End If" branching imposes each and every time through the loop. I like to minimize IF statements inside a loop.