Arrange The Order Based on Indent Level
Sub Arrange_In_Hierarchy_Order()
Dim SSh As Worksheet
Set SSh = ActiveWorkbook.Sheets("Input")
Srcshlastrow = SSh.Range("A" & Rows.Count).End(xlUp).Row
Set Dsh = ActiveWorkbook.Sheets("Output")
Dsh.UsedRange.Clear
For r = 2 To Srcshlastrow
SSh.Range("C" & r).Value = SSh.Range("A" & r).IndentLevel
IndentLevelNumb = SSh.Range("A" & r).IndentLevel + 1
If Dsh.Cells(1, IndentLevelNumb) = "" Then
Dsh.Cells(1, IndentLevelNumb).Value = "Level" & IndentLevelNumb
End If
Next
Dsh.Cells(1, Dsh.UsedRange.Columns.Count + 1).Value = "Salary"
For r = 2 To Srcshlastrow
If r = 2 Then
CurrentIndentLevel = SSh.Range("A" & r).IndentLevel + 1
LastRow = Dsh.Cells(Dsh.Rows.Count, CurrentIndentLevel).End(xlUp).Row + 1
Dsh.Cells(LastRow, CurrentIndentLevel).Value = SSh.Range("A" & r).Value
If CurrentIndentLevel <> 1 Then
For i = CurrentIndentLevel - 1 To 1 Step -1
Dsh.Cells(LastRow, i).Value = "N/A"
Next
End If
End If
If r <> 2 Then
PreviousIndentLevel = SSh.Range("A" & r - 1).IndentLevel + 1
CurrentIndentLevel = SSh.Range("A" & r).IndentLevel + 1
If CurrentIndentLevel > PreviousIndentLevel Then
LastRow = Dsh.UsedRange.Rows.Count
Dsh.Cells(LastRow, CurrentIndentLevel).Value = SSh.Range("A" & r).Value
End If
If CurrentIndentLevel = PreviousIndentLevel Then
LastRow = Dsh.UsedRange.Rows.Count + 1
Dsh.Cells(LastRow, CurrentIndentLevel).Value = SSh.Range("A" & r).Value
For i = CurrentIndentLevel - 1 To 1 Step -1
If Dsh.Cells(LastRow - 1, i).Value = "" And LastRow - 1 <> 1 Then
Dsh.Cells(LastRow - 1, i).Value = "N/A"
End If
Dsh.Cells(LastRow, i).Value = Dsh.Cells(LastRow - 1, i).Value
Next
End If
If CurrentIndentLevel < PreviousIndentLevel Then
LastRow = Dsh.UsedRange.Rows.Count + 1
Dsh.Cells(LastRow, CurrentIndentLevel).Value = SSh.Range("A" & r).Value
For i = CurrentIndentLevel - 1 To 1 Step -1
If Dsh.Cells(LastRow - 1, i).Value = "" And LastRow - 1 <> 1 Then
Dsh.Cells(LastRow - 1, i).Value = "N/A"
End If
Dsh.Cells(LastRow, i).Value = Dsh.Cells(LastRow - 1, i).Value
Next
End If
End If
If CurrentIndentLevel - PreviousIndentLevel > 1 Then
For i = CurrentIndentLevel - 1 To 1 Step -1
If Dsh.Cells(LastRow, i).Value = "" Then
Dsh.Cells(LastRow, i).Value = "N/A"
End If
Next
End If
Dsh.Cells(LastRow, Dsh.UsedRange.Columns.Count).Value = SSh.Range("B" & r).Value
Next
SSh.Activate
SheetName = Dsh.Name
FormatTheOutputSheet (SheetName)
MsgBox "Segregation of Data Completed"
End Sub
Function FormatTheOutputSheet(SheetName)
Dim OSh As Worksheet
Set OSh = ActiveWorkbook.Sheets(SheetName)
OSh.Activate
ActiveWindow.DisplayGridlines = False
With OSh.UsedRange
.ColumnWidth = 20
.HorizontalAlignment = xlLeft
.Font.Name = "Adobe Garamond Pro Bold"
.Font.Size = 15
With .Rows(1)
.Interior.ColorIndex = 1
.Font.ColorIndex = 2
.Font.Size = 18
.HorizontalAlignment = xlCenter
End With
.Cells.Borders.ColorIndex = 9
.Cells.Borders.LineStyle = xlContinuous
.Cells.Borders.Weight = 2
End With
End Function