Results 1 to 7 of 7
  1. #1
    Silver Lounger
    Join Date
    Dec 2000
    Location
    California, USA
    Posts
    1,758
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Divisions and Groupings (XP)

    I have a challenge with divisions and groupings listed in a tree. Usually the child is listed before the parent thus my inquiry. What I would like to do is reshuffle the deck so that parent/child relationships make sense. I'm looking for a VBA solution for the reshuffle.

    I have attached a sample workbook listing the child/parent relationships in Column A. Column E is what I would like to achieve. Known facts are the color of the divisions/groupings and bold text.

    This one has me puzzled. I have tried numerous versions of code and only paint myself further into the corner.

    Thanks for your assistance,
    John
    Attached Files Attached Files

  2. #2
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Divisions and Groupings (XP)

    Did you just edit the text of your post, or have you also replaced the attachment?

  3. #3
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Divisions and Groupings (XP)

    Try the following code:

    Sub SortAll()
    Dim m As Long
    m = Cells(Rows.Count, 1).End(xlUp).Row
    SortLevel 2, m
    End Sub

    Sub SortLevel(StartRow As Long, EndRow As Long)
    Dim r As Long
    Dim s As Long
    Range(Cells(EndRow, 1), Cells(EndRow, 2)).Cut
    Range(Cells(StartRow, 1), Cells(StartRow, 2)).Insert Shift:=xlShiftDown
    r = EndRow
    If Cells(r, 2) < 20 Then
    Do
    s = r - 1
    Do While Cells(r, 2) < Cells(s, 2) And s > StartRow
    s = s - 1
    Loop
    If s + 1 < r Then
    SortLevel s + 1, r
    End If
    r = s
    Loop Until r <= StartRow
    End If
    End Sub

  4. #4
    Silver Lounger
    Join Date
    Dec 2000
    Location
    California, USA
    Posts
    1,758
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Divisions and Groupings (XP)

    Just an edit

  5. #5
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Divisions and Groupings (XP)

    OK, I assumed that in my previous reply.

  6. #6
    Silver Lounger
    Join Date
    Dec 2000
    Location
    California, USA
    Posts
    1,758
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Divisions and Groupings (XP)

    Hans,

    A brilliant solution.

    Many thanks,
    John

  7. #7
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Divisions and Groupings (XP)

    Looking back I see that I left two superfluous lines in the code (if you look closely you'll notice that the indentation is not entirely consistent). Here is the code without those lines:

    Sub SortAll()
    Dim m As Long
    m = Cells(Rows.Count, 1).End(xlUp).Row
    SortLevel 2, m
    End Sub

    Sub SortLevel(StartRow As Long, EndRow As Long)
    Dim r As Long
    Dim s As Long
    Range(Cells(EndRow, 1), Cells(EndRow, 2)).Cut
    Range(Cells(StartRow, 1), Cells(StartRow, 2)).Insert Shift:=xlShiftDown
    r = EndRow
    Do
    s = r - 1
    Do While Cells(r, 2) < Cells(s, 2) And s > StartRow
    s = s - 1
    Loop
    If s + 1 < r Then
    SortLevel s + 1, r
    End If
    r = s
    Loop Until r <= StartRow
    End Sub

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •