CODEWITHSUNDEEP
excelvba
Évariste Galois
Évariste Galois

Reputation: 1033

parent-child based range ordering in VBA

I have the following sheet of data:

Data

As you can see, I have 5 parents, each with their own subtree/range. I want to re-order these parent/subtrees, given a parent-order association in another sheet. My logic is to iterate over the rows until I see another parent, selecting the range, and storing it in some temporary range at the index proportional to total row and range length. The order association sheet looks like:

order

I was thinking of storing this new order in some temporary column in my desired sheet, overwriting the original column then clearing the temporary, but this seems inefficient, and I'm not sure how to implement this logic efficiently in VBA, or if there is an easier logic possible. Any help would be appreciated.

Logic implementation:

i = 2
While ThisWorkbook.Sheets("Formatting").Cells(i, 3) <> ""
looking = 0
j = 8
While ThisWorkbook.Sheets("Weights").Cells(j, 3) <> ""
    If ThisWorkbook.Sheets("Weights").Cells(j, 3) = ThisWorkbook.Sheets("Formatting").Cells(i, 3) Then
        start_row = j
        looking = 1
    End If
    If looking = 1 And ThisWorkbook.Sheets("Weights").Cells(j, 3) <> ThisWorkbook.Sheets("Formatting").Cells(i, 3) Then
        end_row = j - 1
    End If
Wend
ThisWorkbook.Sheets("Weights").Range("start_row:end_row").Cut
ThisWorkbook.Sheets("Weights").Range("1:1").Insert
Wend

Upvotes: 0

Views: 444

Answers (1)

StoneGiant
StoneGiant

Reputation: 1497

Sort your order association table in descending order by the Order column.

This is pseudocode, because I'm assuming you have most of your code already in place.

Loop through your Order Association table
    Set state to Looking
    Loop through the rows of the Root table
        If Root Name matches Association Name
            Remember the row (Start Row)
            Set state to Not Looking
        endif
        if State is Not Looking and Root Name does not match Association Name
            Remember the previous row (End Row)
        endif
    End Loop
    Range(Start Row:End Row).Cut
    Range("1:1").Insert
End Loop

Well, this turned out to be a bit trickier than I expected, but this works in my sample data:

Sub SortWeights()

    Dim formatRow As Integer        ' Current row in ordered list of parents
    Dim weightRow As Integer        ' Current row while sorting weights
    Dim startRow As Integer         ' First row in weights group
    Dim endRow As Integer           ' Last row in weights group
    Dim weightsSheet As Worksheet   ' Worksheet containing weights
    Dim formatSheet As Worksheet    ' Worksheet containing ordered parent weights
    Dim looking As Boolean          ' True while gathering child rows
    Dim doShift As Boolean          ' True if weights group needs to be moved
    Dim candidate As Range          ' Candidate weight
    Dim sortingWeight As Range      ' Reformatted sorting weight name

    Const firstFormatRow As Integer = 1     'First row in ordered list of parents
    Const lastFormatRow As Integer = 3      'Last row in ordered list of parents
    Const firstWeightRow As Integer = 1     'First row in list of weights to be sorted
    Const lastWeightRow As Integer = 8      'Last row in list of weights to be sorted
    Const weightNameColumn As Integer = 3   'Column with parent names to be sorted
    Const formatNameColumn As Integer = 3   'Column with parent names in ascending order

    Set weightsSheet = ActiveWorkbook.Sheets("Weights")
    Set formatSheet = ActiveWorkbook.Sheets("Formatting")

    formatRow = lastFormatRow

    ' Loop through the list of ordered parent weights
    Do Until formatRow < firstFormatRow

        ' Reset everything
        looking = False
        doShift = False
        startRow = 0
        endRow = 0
        Set sortingWeight = formatSheet.Cells(formatRow, formatNameColumn)

        ' Loop through the list of all weights
        For weightRow = firstWeightRow To lastWeightRow

            Set candidate = weightsSheet.Cells(weightRow, weightNameColumn)

            ' If match found, start counting
            If candidate.Value = sortingWeight.Value Then
                ' If the match is in the first row, it is already in place, skip it.
                If weightRow = 1 Then
                    Exit For
                Else
                    startRow = weightRow
                    looking = True
                    doShift = True
                End If
            End If

            ' If gathering children...
            If looking Then
                ' If this is the last row, it is the end of the group.
                If weightRow = lastWeightRow Then
                    endRow = weightRow
                ' Otherwis, if this is a new group, the previous row was the end.
                ElseIf candidate.IndentLevel = 0 And candidate <> sortingWeight Then
                    endRow = weightRow - 1
                    Exit For
                End If
            End If

        Next weightRow

        ' Only do the cut and insert if necessary
        If doShift Then
            weightsSheet.Range(CStr(startRow) & ":" & CStr(endRow)).Cut
            weightsSheet.Range(CStr(firstWeightRow) & ":" & CStr(firstWeightRow)).Insert
        End If

        ' Do the next parent.
        formatRow = formatRow - 1

    Loop

End Sub

You will need to update your constants to match whatever is in your sheets. You could, if you wanted, make the constants variable and use the UsedRange property of the worksheet object to set those values, if you want. That would be a bit more dynamic, but I think that's beyond the scope of this question.

Let me know how it goes. Hope it gets you where you need to be.

Upvotes: 1

Related Questions