Reputation: 1033
I have the following sheet of 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:
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
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