Removing Duplicates Based on Criteria in Cell

[nkw2306]

Hi Fabulous people! I am looking at removing duplicates if they contain False in a certain cell but only if they are duplicates

T	U	V	W	X	Y
26707343702	TRUE	TRUE	30	0	26707343702TRUETRUE
26707343702	TRUE	FALSE			26707343702TRUEFALSE
26707343702	TRUE	FALSE			26707343702TRUEFALSE
26707343702	TRUE	FALSE			26707343702TRUEFALSE
26707343702	TRUE	FALSE			26707343702TRUEFALSE
26707343702	TRUE	FALSE			26707343702TRUEFALSE
26707343702	TRUE	FALSE			26707343702TRUEFALSE
26707343702	TRUE	FALSE			26707343702TRUEFALSE

<tbody>
</tbody>

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

So the cells that contain FALSE in the 3rd Column (Column V) are deleted as long as there is a duplicate. I've tried to use someone else's code but I haven't changed it correctly to reflect my own information as its not working. The code I have is as follows

Dim lastRow1 As Long
Dim myRow As Long

Application.ScreenUpdating = False


' Sort by columns A and B
Range("A1").CurrentRegion.Sort _
key1:=Range("T1"), order1:=xlAscending, _
key2:=Range("V1"), order2:=xlDescending, Header:=xlYes


' Find last row in column A
lastRow1 = Cells(Rows.Count, "A").End(xlUp).Row

' Loop through all rows backwards up to row 2
For myRow = lastRow1 To 2 Step -1
' Check to see if columns A match and column B has "Y" in row, and "N" in row above
If Cells(myRow, "T") = Cells(myRow - 1, "T") And _
UCase(Cells(myRow, "V")) = "True" And _
UCase(Cells(myRow - 1, "V")) = "False" Then
' If so, delete row
Rows(myRow).Delete
End If
Next myRow


Application.ScreenUpdating = True

Appreciate any help you can give me!

 

[mohadin]

Hi
See if this what you want
Option Explicit

Sub your_code()
    Dim lastRow1 As Long
    Dim myRow As Long
    Application.ScreenUpdating = False
    ' Sort by columns A and B
    Range("T1").CurrentRegion.Sort _
            key1:=Range("T1"), order1:=xlAscending, _
            key2:=Range("V1"), order2:=xlAscending, Header:=xlYes
    ' Find last row in column A
    lastRow1 = Cells(Rows.Count, "T").End(xlUp).Row
    ' Loop through all rows backwards up to row 2
    For myRow = lastRow1 To 2 Step -1
        ' Check to see if columns A match and column B has "Y" in row, and "N" in row above
        If Cells(myRow, 20) = Cells(myRow - 1, 20) And _
           UCase(Cells(myRow, 22)) = UCase(Cells(myRow - 1, 22)) Then
            ' If so, delete row
            Rows(myRow).Delete
        End If
    Next myRow
    Application.ScreenUpdating = True
End Sub

 

[nkw2306]

Awesome. I've changed it slightly and now it does what I want it to do!

Thank you for your help. It is much appreciated!

Hi
See if this what you want
Option Explicit

Sub your_code()
    Dim lastRow1 As Long
    Dim myRow As Long
    Application.ScreenUpdating = False
    ' Sort by columns A and B
    Range("T1").CurrentRegion.Sort _
            key1:=Range("T1"), order1:=xlAscending, _
            key2:=Range("V1"), order2:=xlAscending, Header:=xlYes
    ' Find last row in column A
    lastRow1 = Cells(Rows.Count, "T").End(xlUp).Row
    ' Loop through all rows backwards up to row 2
    For myRow = lastRow1 To 2 Step -1
        ' Check to see if columns A match and column B has "Y" in row, and "N" in row above
        If Cells(myRow, 20) = Cells(myRow - 1, 20) And _
           UCase(Cells(myRow, 22)) = UCase(Cells(myRow - 1, 22)) Then
            ' If so, delete row
            Rows(myRow).Delete
        End If
    Next myRow
    Application.ScreenUpdating = True
End Sub

 

[mohadin]

You are very well come
Thank you for the feedback
Be happy