Arrange The Order Based on Indent Level

  • Arrange the Hierarchy Order by considering Indent Level as Base
  •  

     

    Click on the image to watch the video

    Download The Workbook

     

    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
    '----------------Greater---------------------------------------------
    If CurrentIndentLevel > PreviousIndentLevel Then
    LastRow = Dsh.UsedRange.Rows.Count
    Dsh.Cells(LastRow, CurrentIndentLevel).Value = SSh.Range("A" & r).Value
    End If
    '-----------------------------Equal --------------------------------------------
    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
    '----------------------------Less----------------------------------------------
    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