Excel: Indent macros

Sub RestoreIndents()

' Restore indents based on cell to the left

Dim cell As Range

For Each cell In Selection

cell.IndentLevel = cell.Offset(0, -1).Value

Sub CreateGroupingsOnIndents()

If ActiveWorkbook.MultiUserEditing Then

MsgBox ("This can only be done in exclusive mode (Review > Share Workbook)")

Exit Sub

End If

Dim cell As Range

'If (Selection.Rows.Count = 1) And (Selection.Columns.Count = 1) Then

' MsgBox ("Select the cells you wish to group by indent, excluding the first item.")

' Exit Sub

'End If

For Each cell In Selection

cell.EntireRow.OutlineLevel = cell.IndentLevel + 1

Sub CreateIndentsOnGrouping()

If ActiveWorkbook.MultiUserEditing Then

MsgBox ("This can only be done in exclusive mode (Review > Share Workbook)")

Exit Sub

End If

Dim cell As Range

'If (Selection.Rows.Count = 1) And (Selection.Columns.Count = 1) Then

' MsgBox ("Select the cells you wish to group by indent, excluding the first item.")

' Exit Sub

'End If

For Each cell In Selection

cell.IndentLevel = cell.EntireRow.OutlineLevel - 1

Function that can be used in a cell to determine the indent level

Function indentShow(CellObject As Range) As Integer

indentShow = CellObject.IndentLevel

End Function

Or if you're using spaces:

' Select a cell which you will place the calculated result at, and type this formula =FIND(LEFT(TRIM(A1),1),A1)-1

Sub CreateGroupingsOnNumber()

' Create groupings based on selected numbers in cells

If ActiveWorkbook.MultiUserEditing Then

MsgBox ("This can only be done in exclusive mode (Review > Share Workbook)")

Exit Sub

End If

Dim cell As Range

'If (Selection.Rows.Count = 1) And (Selection.Columns.Count = 1) Then

' MsgBox ("Select the cells you wish to group by indent, excluding the first item.")

' Exit Sub

'End If

For Each cell In Selection

cell.EntireRow.OutlineLevel = cell.Text

Project 2010 Conversions

Groupings based on spaces (Project 2010)

Sub CreateGroupingsOnSpaces()

If ActiveWorkbook.MultiUserEditing Then

MsgBox ("This can only be done in exclusive mode (Review > Share Workbook)")

Exit Sub

End If

Dim cell As Range

'If (Selection.Rows.Count = 1) And (Selection.Columns.Count = 1) Then

' MsgBox ("Select the cells you wish to group by indent, excluding the first item.")

' Exit Sub

'End If

For Each cell In Selection

Dim ttOrig As String

Dim ttNew As String

ttOrig = cell.Text

ttNew = LTrim(ttOrig)

cell.EntireRow.OutlineLevel = (Len(ttOrig) - Len(ttNew)) / 3 + 1

Convert spaces to indents and convert indents to spaces (Project 2010)

Sub ConvertSpacesToIndents()

Dim cell As Range

If (Selection.Rows.Count = 1) And (Selection.Columns.Count = 1) Then

MsgBox ("Select the cells you wish to group by indent.")

Exit Sub

End If

ConvertIndentsToSpaces ' Required to stop losing indents on items already indented

For Each cell In Selection

Dim ttOrig As String

Dim ttNew As String

ttOrig = cell.Text

ttNew = LTrim(ttOrig)

cell.IndentLevel = (Len(ttOrig) - Len(ttNew)) / 3

cell.Value = ttNew

Sub ConvertIndentsToSpaces()

Dim cell As Range

For Each cell In Selection

Dim ttOrig As String

Dim ttNew As String

ttNew = cell.Text

For i = 1 To cell.IndentLevel

ttNew = " " & ttNew

cell.IndentLevel = 0

'http://www.mrexcel.com/forum/excel-questions/520950-visual-basic-applications-group-rows-wbs-ms-project.html

Sub DecimalToIndent()

Dim Rng1 As Range 'numbers

Dim rng2 As Range 'descriptions

Dim NumCol As Long

Dim DescCol As Long

Dim TopRow As Long

Dim BotRow As Long

Dim AdStr As String

Dim i As Long

Dim j As Long

Dim k As Long

Set Rng1 = Application.InputBox(prompt:="select the numbers to use as a basis for indentation", Type:=8)

Set rng2 = Application.InputBox(prompt:="select the descriptions to be indented", Type:=8)

AdStr = CStr(Rng1.Address)

AdStr = Left(AdStr, Application.WorksheetFunction.Find(":", AdStr, 1) - 1)

TopRow = Range(AdStr).Row

NumCol = Range(AdStr).Column

AdStr = CStr(rng2.Address)

AdStr = Right(AdStr, Len(AdStr) - Application.WorksheetFunction.Find(":", AdStr, 1))

BotRow = Range(AdStr).Row

DescCol = Range(AdStr).Column

For i = TopRow To BotRow

k = 0

For j = 1 To Len(Cells(i, NumCol))

If Mid(Cells(i, NumCol), j, 1) = "." Then k = k + 1

Next j

Cells(i, DescCol).IndentLevel = k

Next i

End Sub

Sub IndentBasedOnPeriods()

'Indent Task Name column based upon the count of periods in the WBS field

Dim i As Long

For i = 1 To Range("setWBSCount").Count

'Indent each cell by the number of periods found in the WBS

If Range("AD2").Offset(i, 0).Value > 0 Then

Range("E2").Offset(i).IndentLevel = Range("AD2").Offset(i, 0).Value * 2

End If

Next i

End Sub

'http://www.mrexcel.com/forum/excel-questions/520950-visual-basic-applications-group-rows-wbs-ms-project.html

Sub IndentBasedOnWBSLevel()

'If the wbs level (1 ... N) is in col A

Dim cell As Range

Rows.ClearOutline

For Each cell In Range("A2", Cells(Rows.Count, "A").End(xlUp))

cell.EntireRow.OutlineLevel = cell.Value

Next cell

End Sub

Sub NumberWBS()

' Add WBS numbering to the first column.

' To use: Select 2 columns, the first is the column to be numbered,

' the second is the indented task description.

' Edward Chan 2016

Dim lvl1Counter As Integer

Dim lvl2Counter As Integer

Dim lvl3Counter As Integer

Dim InLevel As Integer

Dim WBSno As String

lvl1Counter = 0

lvl2Counter = 0

lvl3Counter = 0

Dim x As Range

Set x = Selection

For i = 1 To x.Rows.Count

Select Case x.Cells(i, 2).IndentLevel

Case 0

lvl1Counter = lvl1Counter + 1

lvl2Counter = 0

lvl3Counter = 0

WBSno = lvl1Counter

Case 1

lvlCounter1 = lvl1Counter

lvl2Counter = lvl2Counter + 1

lvl3Counter = 0

WBSno = lvl1Counter & "." & lvl2Counter

Case 2

lvlCounter1 = lvl1Counter

lvl2Counter = lvl2Counter

lvl3Counter = lvl3Counter + 1

WBSno = lvl1Counter & "." & lvl2Counter & "." & lvl3Counter

End Select

x.Cells(i, 1).Value = "'" & WBSno

Next i

End Sub