Help with Marco - how do I find and delete the whole row if value exists in both columns

[crag8119]

Hi,

In Columns O & P I have values like below:

0	R1177092
0	R1177093
0	R1177227
R1178634	R1178511
0	R1178185
0	R1178634
R1179555	0

<colgroup><col><col></colgroup><tbody>
</tbody>

I need a Marco to find and delete the whole row , if the same values exists in both columns.

For example: R1178634 exists in column O and on a different row column P. I want to delete the whole rows.

Delete row 4 in Columns O
and Delete row 6 in Columns P as value R1178634 exists in both columns.

Thanks

 

[Yongle]

if the same value (R123456789) appears 10 times in column "O" and 6 times in column "P" what should remain in both columns?

if the value appears 6 times in both columns what should remain in both columns?

if the value appears 6 times in column "P" (and not at all in "O") what should remain in both columns?

thanks

 

[crag8119]

if the same value (R123456789) appears 10 times in column "O" and 6 times in column "P" what should remain in both columns?

if the value appears 6 times in both columns what should remain in both columns?

if the value appears 6 times in column "P" (and not at all in "O") what should remain in both columns?

thanks

Hi ,

Thank you again.

I am only delete matches in both columns, the value has to exist in O and P to be deleted.

if the same value (R123456789) appears 10 times in column "O" and 6 times in column "P" what should remain in both columns?
A: Remove 6 from O and 6 from P , leave 4 in O

if the value appears 6 times in both columns what should remain in both columns?
A: 0 - Remove all lines

if the value appears 6 times in column "P" (and not at all in "O") what should remain in both columns?
A: 6 will remain in P as not match in O.

If there was 5 in P and 4 in O , only 4 from both would be deleted. 1 would be left in P.

Hope that makes sense

 

[veyselemre]

Alternative;

Sub TEST()    
    Dim son As Integer, huc As Range, sil As Range
    With CreateObject("Scripting.Dictionary")
        son = Cells(Rows.Count, "O").End(3).Row
        If son > 6000 Then son = 6000
        For Each huc In Range("O30:O" & son).Cells
            If huc.Value <> "" And huc.Value <> 0 Then .Item(huc.Value) = huc.Row
        Next huc
        son = Cells(Rows.Count, "P").End(3).Row
        If son > 6000 Then son = 6000
        For Each huc In Range("P30:P" & son)
            If huc.Value <> "" And huc.Value <> 0 Then
                If .exists(huc.Value) Then
                    If sil Is Nothing Then
                        Set sil = Union(Rows(huc.Row), Rows(.Item(huc.Value)))
                    Else
                        Set sil = Union(sil, Rows(huc.Row), Rows(.Item(huc.Value)))
                    End If
                End If
            End If
        Next huc
    End With
    If Not sil Is Nothing Then sil.Delete
End Sub

 

[Yongle]

try this

Sub DeleteRows()
    Dim c1  As Range, c2 As Range, Rng As Range, r As Long
    With ActiveSheet
        Set Rng = .Range("P30:P6000")
        For r = 6000 To 30 Step -1
            Set c1 = .Cells(r, "O")
            Set c2 = Nothing
            If c1 <> "" And c1 <> 0 Then
                On Error Resume Next
                Set c2 = Rng.Find(c1, LookIn:=xlValues, lookat:=xlWhole)
                On Error GoTo 0
                If Not c2 Is Nothing Then Union(c1, c2).EntireRow.Delete
            End If
        Next r
    End With
End Sub