Loop based on text

[plaem]

I have an Excel file with the following structure:

ID	Value
A	0
A	1
B	0
B	0
B	1
C	0
D	1

What I would like to do is make a script that checks all rows corresponding to each unique ID and, when any of the rows contains a 1, delete all rows with that unique ID. I know how to check the values and delete the rows, but am having trouble to code the cycling through each ID and deleting all corresponding rows when the number is variable. Of course I can make a unique list of the ID's and loop through all rows, however that would not be efficient with the size of the data I have. If I sort the first column in alphabetical order, would it be possible to cycle through the ID's sequentially?

[YasserKhalil]

Can you post the desired output? It is not totally clear ..
If you want to delete all the values of 1 you can use filter

[georgiboy]

As Yasser said autofilter may be the way to go.

Generally deleting rows in excel is slow, looping using a range loop is also slow.

You said you have a large dataset... How large?

It may be worth looking at an array loop if the filter option is not what you are looking for.

[plaem]

Thanks for your reply!
In this case the output is

ID	Value
C	0

as it is the only ID with only a 0 in any of the rows.
Filtering on '1' would not work because I also need to delete rows with a 0 if the ID has a 1 in another row.
I hope this clears up what my objective is.

[YasserKhalil]

What if the unique ID 'C' for example has another zero value .. Will you keep or delete all the rows related to ID 'C'?

[plaem]

What if the unique ID 'C' for example has another zero value .. Will you keep or delete all the rows related to ID 'C'?

Then it should be kept.

[YasserKhalil]

Try this code

Sub Test()
    Dim a           As Variant
    Dim b           As Variant
    Dim r           As Range
    Dim i           As Long


    Application.ScreenUpdating = False
        With Cells(1).CurrentRegion.Resize(, 3)
            .Offset(1).Columns(3).ClearContents
            a = .Value
            ReDim b(1 To UBound(a, 1) - 1, 1 To 1)
    
            With CreateObject("Scripting.Dictionary")
                For i = 2 To UBound(a, 1)
                    If Not .Exists(a(i, 1)) Then
                        Set .Item(a(i, 1)) = CreateObject("Scripting.Dictionary")
                    End If
                    .Item(a(i, 1))(a(i, 2)) = Empty
                Next i
                For i = 2 To UBound(a, 1)
                    b(i - 1, 1) = .Item(a(i, 1)).Count
                Next i
            End With
    
            For i = 2 To UBound(a, 1)
                If a(i, 2) <> 0 Or b(i - 1, 1) > 1 Then
                    If r Is Nothing Then Set r = Cells(i, 1) Else Set r = Union(r, Cells(i, 1))
                End If
            Next i
    
            If Not r Is Nothing Then r.EntireRow.Delete
        End With
    Application.ScreenUpdating = False
End Sub

[plaem]

Thanks! Worked as desired.