Delete Rows based on multiple conditions

[hamaraghar]

Hi I have a table with 3 columns - col_id, col_id2&Col_point.
I have sorted the data for col_id2 and then col_id.

col_id2 has same values for multiple lines and within the same values, col_id has unique values with value 1 common across different col_id2 values.

Problem statement.
I want to delete rows based on the value in Col_point column using listed conditions.
1. If for a given value in col_id2, the corresponding col_point for all the same col_id2 is less than 50, then it should delete everyrows having the same col_id2.
2. If for a given value in col_id2, the corresponding col_point for any same col_id2 is more than 50, then it shoud delete all the rows having the same col_id2 except for the rows where the point is more than 50 AND the row with col_id value as 1.

Example. I need to retain the rows marked with green in col_Id and Col_point.

How can I accomplish this? I can do it one col_id2 at a time but I have data worth 80K+rows and it will take me forever. Is there a way to get it automated using VBA or online script.

I have added the MiniSheet below

Test.xlsx
	A	B	C
1	col_id	col_id2	col_point
2	1	0000a5a5801f9ead	29
3	2	0000a5a5801f9ead	31
4	3	0000a5a5801f9ead	25
5	4	0000a5a5801f9ead	37
6	5	0000a5a5801f9ead	10
7	6	0000a5a5801f9ead	19
8	7	0000a5a5801f9ead	17
9	8	0000a5a5801f9ead	20
10	9	0000a5a5801f9ead	11
11	10	0000a5a5801f9ead	19
12	1	0000a5a5804e45e2	237
13	11	0000a5a5804e45e2	3
14	12	0000a5a5804e45e2	7
15	13	0000a5a5804e45e2	7
16	2	0000a5a5804e45e2	36
17	14	0000a5a5804e45e2	5
18	3	0000a5a5804e45e2	51
19	15	0000a5a5804e45e2	3
20	16	0000a5a5804e45e2	65
21	4	0000a5a5804e45e2	0
22	17	0000a5a5804e45e2	6
23	18	0000a5a5804e45e2	35
24	19	0000a5a5804e45e2	78
25	20	0000a5a5804e45e2	4
26	5	0000a5a5804e45e2	33
27	21	0000a5a5804e45e2	5
28	6	0000a5a5804e45e2	27
29	7	0000a5a5804e45e2	28
30	8	0000a5a5804e45e2	39
31	9	0000a5a5804e45e2	1
32	22	0000a5a5804e45e2	4
33	10	0000a5a5804e45e2	1
34	23	0000a5a5804e45e2	31
35	24	0000a5a5804e45e2	18
36	25	0000a5a5804e45e2	8
37	1	0000a5a580af402b	44
38	2	0000a5a580af402b	42
39	3	0000a5a580af402b	38
40	16	0000a5a580af402b	22
41	4	0000a5a580af402b	1
42	18	0000a5a580af402b	36
43	19	0000a5a580af402b	97
44	5	0000a5a580af402b	6
45	6	0000a5a580af402b	1
46	7	0000a5a580af402b	7
47	8	0000a5a580af402b	4
48	9	0000a5a580af402b	9
49	10	0000a5a580af402b	0
Sheet8

 

[Guna13]

To use this code:

1. Open your Excel workbook.
2. Press "Alt + F11" to open the VBA editor.
3. Insert a new module (if you don't have one already) by clicking "Insert" from the menu and then "Module."
4. Paste the provided VBA code into the module.
5. Close the VBA editor and return to your worksheet.
6. Run the macro by pressing "Alt + F8," selecting "DeleteRowsBasedOnConditions," and clicking "Run."

This VBA code will go through your data and delete rows based on the conditions you described. Please be cautious and take a backup of your data before running the macro, as it performs deletion operations.

Sub DeleteRowsBasedOnConditions()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim colID2 As Range
    Dim uniqueColID2 As Collection
    Dim i As Long, j As Long
    Dim deleteRows As Boolean
    
    ' Update the sheet name with the actual sheet name where your data is located
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    ' Find the last row in column A (col_id2)
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    ' Set the range for col_id2
    Set colID2 = ws.Range("A2:A" & lastRow)
    
    ' Create a collection to store unique col_id2 values
    Set uniqueColID2 = New Collection
    
    ' Loop through col_id2 to get unique values and apply conditions
    For i = 1 To colID2.Rows.Count
        If Not IsError(colID2.Cells(i, 1).Value) Then
            On Error Resume Next
            uniqueColID2.Add colID2.Cells(i, 1).Value, CStr(colID2.Cells(i, 1).Value)
            On Error GoTo 0
        End If
    Next i
    
    ' Loop through unique col_id2 values and apply conditions
    For j = 1 To uniqueColID2.Count
        deleteRows = True
        For i = 1 To lastRow
            If ws.Cells(i, 1).Value = uniqueColID2(j) Then
                ' Condition 1: Check if any col_point is greater than or equal to 50
                If ws.Cells(i, 3).Value >= 50 Then
                    deleteRows = False
                End If
                ' Condition 2: Check if any col_id is equal to 1 and col_point is greater than or equal to 50
                If ws.Cells(i, 1).Value = 1 And ws.Cells(i, 3).Value >= 50 Then
                    deleteRows = False
                End If
            End If
        Next i
        
        ' Delete the rows based on the conditions
        If deleteRows Then
            For i = lastRow To 1 Step -1
                If ws.Cells(i, 1).Value = uniqueColID2(j) Then
                    ws.Rows(i).Delete
                End If
            Next i
        End If
    Next j
End Sub

 

[Peter_SSs]

I have sorted the data for col_id2 and then col_id.

That does not seem to be the case to me. Here all the col_id2 values are the same but it is not sorted by col_id

 

[hamaraghar]

To use this code:

1. Open your Excel workbook.
2. Press "Alt + F11" to open the VBA editor.
3. Insert a new module (if you don't have one already) by clicking "Insert" from the menu and then "Module."
4. Paste the provided VBA code into the module.
5. Close the VBA editor and return to your worksheet.
6. Run the macro by pressing "Alt + F8," selecting "DeleteRowsBasedOnConditions," and clicking "Run."

This VBA code will go through your data and delete rows based on the conditions you described. Please be cautious and take a backup of your data before running the macro, as it performs deletion operations.

Sub DeleteRowsBasedOnConditions()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim colID2 As Range
    Dim uniqueColID2 As Collection
    Dim i As Long, j As Long
    Dim deleteRows As Boolean
   
    ' Update the sheet name with the actual sheet name where your data is located
    Set ws = ThisWorkbook.Worksheets("Sheet1")
   
    ' Find the last row in column A (col_id2)
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
   
    ' Set the range for col_id2
    Set colID2 = ws.Range("A2:A" & lastRow)
   
    ' Create a collection to store unique col_id2 values
    Set uniqueColID2 = New Collection
   
    ' Loop through col_id2 to get unique values and apply conditions
    For i = 1 To colID2.Rows.Count
        If Not IsError(colID2.Cells(i, 1).Value) Then
            On Error Resume Next
            uniqueColID2.Add colID2.Cells(i, 1).Value, CStr(colID2.Cells(i, 1).Value)
            On Error GoTo 0
        End If
    Next i
   
    ' Loop through unique col_id2 values and apply conditions
    For j = 1 To uniqueColID2.Count
        deleteRows = True
        For i = 1 To lastRow
            If ws.Cells(i, 1).Value = uniqueColID2(j) Then
                ' Condition 1: Check if any col_point is greater than or equal to 50
                If ws.Cells(i, 3).Value >= 50 Then
                    deleteRows = False
                End If
                ' Condition 2: Check if any col_id is equal to 1 and col_point is greater than or equal to 50
                If ws.Cells(i, 1).Value = 1 And ws.Cells(i, 3).Value >= 50 Then
                    deleteRows = False
                End If
            End If
        Next i
       
        ' Delete the rows based on the conditions
        If deleteRows Then
            For i = lastRow To 1 Step -1
                If ws.Cells(i, 1).Value = uniqueColID2(j) Then
                    ws.Rows(i).Delete
                End If
            Next i
        End If
    Next j
End Sub

Thanks Guna13..

The output that I got is

The output that I am looking for is

For most part the macro works..
May be I wasn't able to explain the condition properly.

For each set of unique col_id2, there are unique entries in col_id with 1 being in all the unique col_id2.

1. Except for col_id = 1, If any col_point for a given set of unique col_id2 is less than 50, then that row should be deleted.
2. Except for col_id = 1, If any col_point for a given set of unique col_id2 is more than 50, then that row should not be deleted and the row with col_id=1 for that unique col_id2 should not be deleted.
3. If all the col_point for a given unique col_id2 is less than 50, then all the rows for that unique col_id2 should be deleted.
4. If all the col_point for a given unique col_id2 is less than 50, but for col_id = 1; the col_point is more than 50, then col_id =1 row should not be deleted.

Thank you so much for your help.

 

[hamaraghar]

That does not seem to be the case to me. Here all the col_id2 values are the same but it is not sorted by col_id

View attachment 96431

Thank you Peter for your reponse...

May be I wasn't able to explain the condition properly.

For each set of unique col_id2, there are unique entries in col_id with 1 being in all the unique col_id2.

1. Except for col_id = 1, If any col_point for a given set of unique col_id2 is less than 50, then that row should be deleted.
2. Except for col_id = 1, If any col_point for a given set of unique col_id2 is more than 50, then that row should not be deleted and the row with col_id=1 for that unique col_id2 should not be deleted.
3. If all the col_point for a given unique col_id2 is less than 50, then all the rows for that unique col_id2 should be deleted.
4. If all the col_point for a given unique col_id2 is less than 50, but for col_id = 1; the col_point is more than 50, then col_id =1 row should not be deleted.

Thank you so much for your help.

 

[Guna13]

Thanks Guna13..

The output that I got is

View attachment 96436

The output that I am looking for is
View attachment 96437

For most part the macro works..
May be I wasn't able to explain the condition properly.

For each set of unique col_id2, there are unique entries in col_id with 1 being in all the unique col_id2.

1. Except for col_id = 1, If any col_point for a given set of unique col_id2 is less than 50, then that row should be deleted.
2. Except for col_id = 1, If any col_point for a given set of unique col_id2 is more than 50, then that row should not be deleted and the row with col_id=1 for that unique col_id2 should not be deleted.
3. If all the col_point for a given unique col_id2 is less than 50, then all the rows for that unique col_id2 should be deleted.
4. If all the col_point for a given unique col_id2 is less than 50, but for col_id = 1; the col_point is more than 50, then col_id =1 row should not be deleted.

Thank you so much for your help.

if you ok, please accept and like comments - Thanks .

 

[hamaraghar]

if you ok, please accept and like comments - Thanks .

Thanks. I have liked the solution but my requirements are still not met.

Thanks for your response and if possible, can you modify the code as per my requirement.

Thanks,

 

[Peter_SSs]

Give this a try with a copy of your workbook. I have assumed column D is empty.

BTW, I suggest that you update your Account details (click your user name at the top right of the forum) so helpers always know what Excel version(s) & platform(s) you are using as the best solution often varies by version. (Don’t forget to scroll down & ‘Save’)

Sub Del_rws()
  Dim a As Variant, b As Variant
  Dim nc As Long, i As Long, j As Long, k As Long, fr As Long, r As Long
 
  a = Range("A1", Range("C" & Rows.Count).End(xlUp).Offset(1)).Value
  ReDim b(1 To UBound(a), 1 To 1)
  nc = 4
  i = 2
  
  Do
    If a(i, 2) <> a(i - 1, 2) Then
      j = 0
      r = 0
    End If
    If a(i, 1) = 1 Then fr = i
    Do
      If a(i + j, 1) <> 1 And a(i + j, 3) < 50 Then
        b(i + j, 1) = 1
        k = k + 1
        r = r + 1
      End If
      j = j + 1
    Loop Until a(i + j, 2) <> a(i, 2) Or i + j >= UBound(a)
    If r = j - 1 Then
      b(fr, 1) = 1
      k = k + 1
    End If
      i = i + j
      j = 0
  Loop Until i >= UBound(a)
    
  If k > 0 Then
    Application.ScreenUpdating = False
    With Range("A1").Resize(UBound(a), nc)
      .Columns(nc).Value = b
      .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlYes
      .Offset(1).Resize(k).EntireRow.Delete
    End With
    Application.ScreenUpdating = True
  End If
End Sub

 

[hamaraghar]

Give this a try with a copy of your workbook. I have assumed column D is empty.

BTW, I suggest that you update your Account details (click your user name at the top right of the forum) so helpers always know what Excel version(s) & platform(s) you are using as the best solution often varies by version. (Don’t forget to scroll down & ‘Save’)

Sub Del_rws()
  Dim a As Variant, b As Variant
  Dim nc As Long, i As Long, j As Long, k As Long, fr As Long, r As Long
 
  a = Range("A1", Range("C" & Rows.Count).End(xlUp).Offset(1)).Value
  ReDim b(1 To UBound(a), 1 To 1)
  nc = 4
  i = 2
 
  Do
    If a(i, 2) <> a(i - 1, 2) Then
      j = 0
      r = 0
    End If
    If a(i, 1) = 1 Then fr = i
    Do
      If a(i + j, 1) <> 1 And a(i + j, 3) < 50 Then
        b(i + j, 1) = 1
        k = k + 1
        r = r + 1
      End If
      j = j + 1
    Loop Until a(i + j, 2) <> a(i, 2) Or i + j >= UBound(a)
    If r = j - 1 Then
      b(fr, 1) = 1
      k = k + 1
    End If
      i = i + j
      j = 0
  Loop Until i >= UBound(a)
   
  If k > 0 Then
    Application.ScreenUpdating = False
    With Range("A1").Resize(UBound(a), nc)
      .Columns(nc).Value = b
      .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlYes
      .Offset(1).Resize(k).EntireRow.Delete
    End With
    Application.ScreenUpdating = True
  End If
End Sub

Thanks Peter.
When I run macro with your code, I'm getting an error @ .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlYes
The error is Run time error '1004'. Sort method of range class failed. When I click on End on the popup. The error box dissappears and i get the 1s and blanks in the 4th column which are correct.
IS there a way to get rid of the error so that I dont have to click on the End or Debug

 

[hamaraghar]

Thanks Peter.
When I run macro with your code, I'm getting an error @ .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlYes
The error is Run time error '1004'. Sort method of range class failed. When I click on End on the popup. The error box dissappears and i get the 1s and blanks in the 4th column which are correct.
IS there a way to get rid of the error so that I dont have to click on the End or Debug

When I add some unique values in column 2 which are not repeatative, I am not getting the blanks for values more than 50 in column 4. Until the colored data set the code works with the error that I mentioned above but with the new data which I added below that with, I'm gettting 1s for everything. if there is a single entry in column2, then if column 3 is less than 50, it should be marked for deletion irrespective of what is in column 1. My apologies as I missed this one more condition as I was manully deleting rows for this condition.

Thanks once again Peter