Parent/Child sorting like a tree for requirements tracking

[tralston]

I have a spreadsheet with requirements for a project, and there are two columns that I need to determine the sorting. First column (Req #) is often a parent to the child column (Parent Req #). See images for more details. I'll have rows that don't have a parent req #, but when they do, I'd like those records "inserted" between the parent, and the next numerically sorted rows.

To illustrate, here's a before / after sort that I'd like to accomplish:

In the second half (sorted), notice that I've changed the indenting to better communicate which rows are children to preceding rows. The indentation is not needed as part of the solution.

Can you see how ITEM-3 immediately follows ITEM-2? ITEM-9 follows ITEM-3 (because it's a child of ITEM-3), and ITEM-8 follows ITEM-9 (because it's a child of ITEM-2, and there are no more ITEM-3 children).

Note: I've already tried doing this with the advanced sorting dialog, and it didn't seem to work. I'm guessing I need to look into a custom sort column, but I'm stuck as to how to write the formula for what I'm trying to do.

Any suggestions?

 

[kevin9999]

Please try the following with a copy of your data. I'm sure there must be a more elegant solution than this, but it does work on the sample data you've provided. I don't know how it will go with a much larger data set, or if there are more levels of parent/child than you indicate. It might serve you until a better solution comes along. Put the following code in a standard module, and run it with the sheet with the data active. Let me know how you go.

Option Explicit
Sub Parents()
    Dim lr As Long, x As Long, y As Long, z As Long
    Dim rng1 As Range, rng2 As Range, c As Range
    lr = Cells(Rows.Count, "B").End(3).Row
    Set rng1 = Range("B2:B" & lr)
    Set rng2 = Range("C2:C" & lr)
    Application.ScreenUpdating = False
    
    For Each c In rng2
        If c <> "" Then
            x = Application.Match(c, rng1, 0) + 1
            rng1.Cells(x, 1).Resize(1, 3).Insert xlShiftDown
            With c.Offset(, -1).Resize(1, 3)
                .Copy rng1.Cells(x, 1)
                .Delete xlShiftUp
            End With
        End If
    Next c
    
    Set rng2 = Range("C3:C" & lr)
    For Each c In rng2
        If c <> "" Then
            y = Right(c, 1)
            z = Right(c.Offset(-1, -1), 1)
            If z > y Then
                c.Offset(-1, -1).Resize(1, 3).Insert xlShiftDown
                With c.Offset(, -1).Resize(1, 3)
                    .Select
                    .Copy c.Offset(-2, -1)
                    .Delete xlShiftUp
                End With
            End If
        End If
    Next c
    
    For Each c In rng1
        If c.Offset(, 1) <> "" Then
            c = Chr(32) & Chr(32) & c
            If Right(c.Offset(-1, 1), 1) <> "" And Right(c.Offset(, 1), 1) > Right(c.Offset(-1, 1), 1) Then
                c = Chr(32) & Chr(32) & c
            End If
        End If
    Next c
    
    Application.ScreenUpdating = True
End Sub

 

[kevin9999]

Have you had the opportunity to try the code yet?