Deleting rows based on values in next row

[snowyday]

Hi All,
I have a file from our SAP system that exports our company's organizational structure. It contains rows for each individual org relationship. I need to send this data to an external vendor that only wants one row per relationship, so they don't have to process extra rows.
The example below shows how the data comes out of SAP. You can see that Executive Leadership is repeated on lines 1, 2 and 3, and that Chief Financial Officer is repeated on lines 2 and 3. What I need to provide to the external vendor is line 3, which contains the entire reporting relationship.

I'm looking for some code that will compare line 1 with line 2 to see if all of the values exist, if they do, then delete the row or mark it for delete somehow. Then it take the next row and compare it to the one after. I hope I'm making sense....

The real file has eight levels of organization units and over 1000 rows.

Thanks



[TABLE="class: grid, width: 500, align: left"]
<tbody>[TR]
[TD]Lvl 1 Id[/TD]
[TD]Lvl 1 Name[/TD]
[TD]Lvl 2 Id[/TD]
[TD]Lvl 2 Name[/TD]
[TD]Lvl 3 Id[/TD]
[TD]Lvl 3 Name[/TD]
[/TR]
[TR]
[TD]55623544[/TD]
[TD]Executive Leadership[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]55623544[/TD]
[TD]Executive Leadership[/TD]
[TD]98564755[/TD]
[TD]Chief Financial Officer[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]55623544[/TD]
[TD]Executive Leadership[/TD]
[TD]98564755[/TD]
[TD]Chief Financial Officer[/TD]
[TD]32554457[/TD]
[TD]32554457[/TD]
[/TR]
</tbody>[/TABLE]

 

[Fluff]

How about

Sub DeleteLevels()

   Dim Cl As Range
   Dim Rng As Range
   
   Set Rng = Range("A" & Rows.Count).End(xlUp).Offset(1)
   With CreateObject("scripting.dictionary")
      For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
         If Not .exists(Cl.Value) Then
            .Add Cl.Value, Cl
         ElseIf WorksheetFunction.CountA(Rows(Cl.Row)) > WorksheetFunction.CountA(Rows(.Item(Cl.Value).Row)) Then
            Set Rng = Union(Rng, .Item(Cl.Value))
            Set .Item(Cl.Value) = Cl
         Else
            Set Rng = Union(Rng, Cl)
         End If
      Next Cl
   End With
   If Not Rng Is Nothing Then Rng.EntireRow.Interior.Color = vbRed
End Sub

This will currently just highlight the rows to be deleted, if it's working ok then change the last line to this

   If Not Rng Is Nothing Then Rng.EntireRow.Delete