Help creating a macro to identify and delete specific rows.

[Dez23]

Hello, I have a spreadsheet that I would like to add a macro to to identify that if in column H there is an output that reads COF01, to find the obligation number in coulmn B in the same row. Then identify all other rows of data that have the same obligation number and delete them. I have attached a small example of the s/s, so the goal is that all rows that are highlighted purple would automatically be deleted out. If anyone could provide a marco or suggestions of how to creat one I would really appriciate it. Thank you!Example.xlsx

[AlvaroSiza]

Why would the white block of 0449 above the purple block of 0449 not be deleted if:

Then identify all other rows of data that have the same obligation number and delete them.

The following hides the rows for now, until we are sure it is right.

Sub ASDelete()

Dim rngCell As Range
Dim rngCell2 As Range
Dim rngObligor As Range
Dim rngAccID As Range
Dim rngNumber As Range
Dim calcState As Long

Set rngObligor = Sheets("Sheet1").Range("A2", Range("A2").End(xlDown))
Set rngAccID = Sheets("Sheet1").Range("H2", Range("H2").End(xlDown))
calcState = Application.Calculation

   With Application
      .ScreenUpdating = False
      .EnableEvents = False
      .Calculation = xlCalculationManual
   End With

      For Each rngCell In rngAccID
         If rngCell.Value = "COF01" Then
            Set rngNumber = rngCell.Offset(0, -7)
            For Each rngCell2 In rngObligor
               If rngCell2 = rngNumber Then
                  rngCell2.EntireRow.Hidden = True
               End If
            Next
         End If
      Next

   With Application
      .ScreenUpdating = True
      .EnableEvents = True
      .Calculation = calcState
   End With

End Sub

[Dez23]

Thanks for the reply, the white block of 0449 would not be deleted because it contains different obligation numbers in column B. I need the macro to identify the ids in column B and then delete all the rows that have the same id in column B.

[AlvaroSiza]

This will hide them for now. I'm erroring on deleting but need to run. I can revisit this evening.

Sub ASDelete()

Dim rngCell As Range
Dim rngCell2 As Range
Dim rngObligor As Range
Dim rngAccID As Range
Dim rngNumber As Range
Dim calcState As Long

Set rngObligor = Sheets("Sheet1").Range("B2", Range("B2").End(xlDown))
Set rngAccID = Sheets("Sheet1").Range("H2", Range("H2").End(xlDown))
calcState = Application.Calculation

   With Application
      .ScreenUpdating = False
      .EnableEvents = False
      .Calculation = xlCalculationManual
   End With

      For Each rngCell In rngAccID
         If rngCell.Value = "COF01" Then
            For Each rngCell2 In rngObligor
            Set rngNumber = rngCell.Offset(0, -6)
               If rngCell2 = rngNumber Then
                  rngCell2.EntireRow.Hidden = True
               End If
            Next
         End If
      Next

   With Application
      .ScreenUpdating = True
      .EnableEvents = True
      .Calculation = calcState
   End With

End Sub

[Dez23]

Thank you that worked great! let me know if you update it to deleting the rows.