Delete rows based on 3 criteria

[Jak]

Hi, I am looking for a VBA solution to automate the removal of unwanted data. The number of records varies.

In the image below, I have highlighted 4 rows I wish to keep. This is a small representation of the data.

Each ID number has a REV number and a State. I need to keep the lowest Rev number row for each ID where the State is either Committed or Done. So when the unwanted data is removed, I would end up with a header row and the 4 rows in this example.

Any help with this would be appreciated.

 

[DanteAmor]

If the data is sorted by ID and Rev number, then try the following code on a copy of your sheet.

Sub deleterows()
  Dim rng As Range
  Dim i As Long, lr As Long
  Dim dic As Object
  Dim cad As String
  
  lr = Range("A" & Rows.Count).End(3).Row
  Set rng = Range("A" & lr + 1)
  Set dic = CreateObject("Scripting.Dictionary")
  
  For i = 2 To lr
    If Range("G" & i).Value = "Committed" Or Range("G" & i).Value = "Done" Then
      cad = Range("A" & i).Value & "|" & Range("G" & i).Value
      If Not dic.exists(cad) Then
        dic(cad) = Empty
      Else
        Set rng = Union(rng, Range("A" & i))
      End If
    Else
        Set rng = Union(rng, Range("A" & i))
    End If
  Next
  rng.EntireRow.Delete
End Sub

---------------
NOTE XL2BB:
For the future, it would help greatly if you could give us the sample data in a form that we can copy to test with, rather that a picture.
MrExcel has a tool called “XL2BB” that lets you post samples of your data that will allow us to copy/paste it to our Excel spreadsheets, so we can work with the same copy of data that you are. Instructions on using this tool can be found here: XL2BB Add-in
Note that there is also a "Test Here” forum on this board. This is a place where you can test using this tool (or any other posting techniques that you want to test) before trying to use those tools in your actual posts.

 

[Jak]

If the data is sorted by ID and Rev number, then try the following code on a copy of your sheet.

Sub deleterows()
  Dim rng As Range
  Dim i As Long, lr As Long
  Dim dic As Object
  Dim cad As String
 
  lr = Range("A" & Rows.Count).End(3).Row
  Set rng = Range("A" & lr + 1)
  Set dic = CreateObject("Scripting.Dictionary")
 
  For i = 2 To lr
    If Range("G" & i).Value = "Committed" Or Range("G" & i).Value = "Done" Then
      cad = Range("A" & i).Value & "|" & Range("G" & i).Value
      If Not dic.exists(cad) Then
        dic(cad) = Empty
      Else
        Set rng = Union(rng, Range("A" & i))
      End If
    Else
        Set rng = Union(rng, Range("A" & i))
    End If
  Next
  rng.EntireRow.Delete
End Sub

---------------
NOTE XL2BB:
For the future, it would help greatly if you could give us the sample data in a form that we can copy to test with, rather that a picture.
MrExcel has a tool called “XL2BB” that lets you post samples of your data that will allow us to copy/paste it to our Excel spreadsheets, so we can work with the same copy of data that you are. Instructions on using this tool can be found here: XL2BB Add-in
Note that there is also a "Test Here” forum on this board. This is a place where you can test using this tool (or any other posting techniques that you want to test) before trying to use those tools in your actual posts.

Thanks for the quick reply and code, works a treat. Thanks muchly for the tip on XL2BB

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.