PDA

View Full Version : Loop based on text



plaem
07-06-2018, 01:47 AM
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
07-06-2018, 02:02 AM
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
07-06-2018, 02:09 AM
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
07-06-2018, 02:10 AM
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
07-06-2018, 02:15 AM
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
07-06-2018, 02:35 AM
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
07-06-2018, 04:28 AM
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
07-16-2018, 12:18 AM
Thanks! Worked as desired.