Sub miApplyIndent()
Dim aCodePane As VBIDE.CodePane, aStartLine As Long, aStartColumn As Long
Dim aEndLine As Long, aEndColumn As Long, aLineNumber As Long
Dim aLine As String, aIndentLevel As Integer, aLineIsAfterUnderscore As Boolean
Dim aIncThisIndent As Boolean, aDecThisIndent As Boolean
Dim aIncNextIndent As Boolean, aDecNextIndent As Boolean
Set aCodePane = ActiveWorkbook.VBProject.VBE.ActiveCodePane
aCodePane.GetSelection aStartLine, aStartColumn, aEndLine, aEndColumn
For aLineNumber = aStartLine To aEndLine
aLine = aCodePane.CodeModule.Lines(aLineNumber, 1)
Do Until Left(aLine, 1) <> " "
aCodePane.CodeModule.ReplaceLine aLineNumber, Mid(aLine, 2)
aLine = aCodePane.CodeModule.Lines(aLineNumber, 1)
Loop 'Loop repeats until all spaces/indents removed
Next aLineNumber
For aLineNumber = aStartLine To aEndLine
aLine = aCodePane.CodeModule.Lines(aLineNumber, 1)
Select Case Left(aLine, IIf(InStr(aLine, " ") = 0, 999, InStr(aLine, " ") - 1))
Case "Do", "For", "Private", "Select", "Sub", "While", "With"
aIncNextIndent = True 'After certain keywords, indent next line
Case "If" 'After If, where line ends in Then, indent next line
If Right(aLine, 4) = "Then" Then aIncNextIndent = True
Case "Loop", "Next", "End" 'At Loop, Next, End, un-indent this line
aDecThisIndent = True
Case "Case", "Else", "ElseIf"
aDecThisIndent = True 'Un-indent Case or Else
aIncNextIndent = True 'Indent line after Case or Else
End Select
If Right(aLine, 2) = " _" And Not aLineIsAfterUnderscore Then
aIncNextIndent = True 'Indent line after underscore
aLineIsAfterUnderscore = True 'Set a flag to un-indent the line after next
ElseIf Right(aLine, 2) <> " _" And aLineIsAfterUnderscore Then
aDecNextIndent = True
aLineIsAfterUnderscore = False
End If
If aIncThisIndent Then aIndentLevel = aIndentLevel + 1: aIncThisIndent = False
If aDecThisIndent Then aIndentLevel = aIndentLevel - 1: aDecThisIndent = False
On Error GoTo lIndentError
aCodePane.CodeModule.ReplaceLine aLineNumber, Space$(aIndentLevel * 4) & aLine
On Error GoTo 0
If aIncNextIndent Then aIndentLevel = aIndentLevel + 1: aIncNextIndent = False
If aDecNextIndent Then aIndentLevel = aIndentLevel - 1: aDecNextIndent = False
Next aLineNumber
Exit Sub
lIndentError:
If aIndentLevel < 0 Then aIndentLevel = 0 'Will not happen unless extra lines selected
Resume Next
End Sub