Replicate IndenterVBA.exe Com add-in

pedie

Well-known Member
Joined
Apr 28, 2010
Messages
3,875
Hi everyone, I use IndenterVBA.exe (Office Automation Ltd. - Smart Indenter) which is like super useful in indentation...
but I cannot use this in office; management won't approve many 3rd party tools/utilities.

Now i'm trying to write some code which will help create something similar; if some one have similar please share or help me where to begin.

Thanks
Pedie.
 

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
hi, Pedie

Your situation occurred to me too, at a previous workplace.

I recall that via Google I did find an alternative indenter that someone had written. This was a while ago & I don't remember it. Where I work now it isn't a problem.

In the early days I did write some code. I think it was OK for my requirements, so I've posted it below to give you some ideas. But better to google, I'd suggest.

regards

Code:
Option Explicit'
' Comments  : Code Indenter
'
' REQUIRED REFERENCE : Microsoft Visual Basic for Applications Extensibility 5.3
'
' Date        Change
' ------------------------------------------------
' 16-May-13 Created
'
'
Public gstr_Wbk_Name As String
'


Sub MyCodeIndenter()
  
  Dim iLoop As Long
  Dim arListOfCodeModules() As String
  Dim vbComp As VBIDE.VBComponent
  
  uf_Workbooks.Show
  
  If Len(gstr_Wbk_Name) > 0 Then
    
    ReDim arListOfCodeModules(1 To 500)
    For Each vbComp In Application.Workbooks(gstr_Wbk_Name).VBProject.VBComponents
      If vbComp.CodeModule.CountOfLines > 3 Then
        iLoop = iLoop + 1
        arListOfCodeModules(iLoop) = vbComp.Name
      End If
    Next vbComp
    Set vbComp = Nothing
    
    If iLoop > 0 Then
      ReDim Preserve arListOfCodeModules(1 To iLoop)
      For iLoop = LBound(arListOfCodeModules) To UBound(arListOfCodeModules)
        Call IndentModule(NameOfModule:=arListOfCodeModules(iLoop))
      Next iLoop
    End If
    Erase arListOfCodeModules
    
    MsgBox prompt:="Done", Buttons:=vbExclamation, Title:="VBA Code Indented for file " & gstr_Wbk_Name
    
  End If
  
End Sub
  
Private Sub IndentModule(ByVal NameOfModule As String)
  
  Const IndentStep As Long = 2
  
  Dim blnInitialCommentInModule As Boolean
  Dim blnIndentNextLine As Boolean, blnOutdentNow As Boolean
  Dim blnNoIndent As Boolean
  
  Dim iLoop As Long, HowManyIndents As Long
  Dim strMyCodeLine As String
  Dim vbComp As VBIDE.VBComponent
  Dim vbProj As VBIDE.VBProject
  
  Set vbProj = Workbooks(gstr_Wbk_Name).VBProject
  Set vbComp = vbProj.VBComponents(NameOfModule)
  
  With vbComp.CodeModule
    
    blnNoIndent = False
    blnInitialCommentInModule = True
    blnIndentNextLine = False
    blnOutdentNow = False
    
    For iLoop = 1 To .CountOfLines
      
      strMyCodeLine = Trim$(.Lines(iLoop, 1))
      
      If Len(strMyCodeLine) > 0 Then
        
        Select Case FirstWord(strMyCodeLine)
          
        Case "Option"
          blnNoIndent = True
          
        Case "Declare", "Enum", "Function", "Private", "Public", "Sub", "Type"
          blnNoIndent = True
          blnInitialCommentInModule = False
          
        Case "If", "IIf"
          If InStr(strMyCodeLine, " Then ") = 0 Then
            blnIndentNextLine = True
          End If
          blnInitialCommentInModule = False
                
        Case "Do", "For", "Select", "With"
          blnIndentNextLine = True
          blnInitialCommentInModule = False
                
        Case "Case"
          'if PREVIOUS line was not a Select or Case statement, outdent now
          If Len(.Lines(iLoop - 1, 1)) > 0 Then
            If Not FirstWord(Trim$(.Lines(iLoop - 1, 1))) Like "Case" And Not FirstWord(Trim$(.Lines(iLoop - 1, 1))) Like "Select" Then
              blnOutdentNow = True
            End If
          End If
          'if NEXT line is not an End or Case statement, indent next line
          If Len(.Lines(iLoop + 1, 1)) > 0 Then
            If Not FirstWord(Trim$(.Lines(iLoop + 1, 1))) Like "End" And Not FirstWord(Trim$(.Lines(iLoop + 1, 1))) Like "Case" Then
              blnIndentNextLine = True
            End If
          End If
                          
        Case "Else", "ElseIf"
          blnOutdentNow = True
          blnIndentNextLine = True
          blnInitialCommentInModule = False
          
        Case "End"
          If strMyCodeLine Like "End Function*" Or strMyCodeLine Like "End Sub*" Then
            blnNoIndent = True
          End If
          If strMyCodeLine Like "End If*" Or strMyCodeLine Like "End Select*" Or strMyCodeLine Like "End With*" Then
            blnOutdentNow = True
          End If
          blnInitialCommentInModule = False
          
        Case "Loop", "Next"
          blnOutdentNow = True
          blnInitialCommentInModule = False
          
        Case Else
          If FirstWord(strMyCodeLine) Like "*:" Then
            blnNoIndent = True
          End If
            
        End Select
        
      End If
      
      If blnNoIndent Then HowManyIndents = 0
      If blnOutdentNow Then HowManyIndents = HowManyIndents - 1
      
      .ReplaceLine iLoop, String(HowManyIndents * IndentStep, " ") & strMyCodeLine
      
      If HowManyIndents = 0 Then HowManyIndents = 1
      If blnInitialCommentInModule Then HowManyIndents = 0
      If blnIndentNextLine Then HowManyIndents = HowManyIndents + 1
      
      blnNoIndent = False
      blnIndentNextLine = False
      blnOutdentNow = False
      
    Next iLoop
    
  End With
  
  Set vbComp = Nothing
  Set vbProj = Nothing
  
End Sub
  
Private Function FirstWord(ByVal WholeLine As String) As String
  
  Dim ar As Variant
  ar = Split(WholeLine, " ")
  FirstWord = ar(LBound(ar))
  
End Function
 
Upvote 0
Well I needed the indenter in a new workplace & there was one small section of code I just changed as it wasn't indenting correctly - the 'IF *** THEN' lines.

The new code is below & only a couple of lines have changed in one place. cheers

Code:
Option Explicit


' Comments  : Code Indenter
'
' REQUIRED REFERENCE : Microsoft Visual Basic for Applications Extensibility 5.3
'
' Date        Change
' ------------------------------------------------
' 16-May-13 Created
' 16-Jun-16 Fix up handling of "IF *** THEN"
'


Public gstr_Wbk_Name As String
'


Sub MyCodeIndenter()
  
  Dim iLoop As Long
  Dim arListOfCodeModules() As String
  Dim vbComp As VBIDE.VBComponent
  
  uf_Workbooks.Show
  
  If Len(gstr_Wbk_Name) > 0 Then
    
    ReDim arListOfCodeModules(1 To 500)
    For Each vbComp In Application.Workbooks(gstr_Wbk_Name).VBProject.VBComponents
      If vbComp.CodeModule.CountOfLines > 3 Then
        iLoop = iLoop + 1
        arListOfCodeModules(iLoop) = vbComp.Name
      End If
    Next vbComp
    Set vbComp = Nothing
    
    If iLoop > 0 Then
      ReDim Preserve arListOfCodeModules(1 To iLoop)
      For iLoop = LBound(arListOfCodeModules) To UBound(arListOfCodeModules)
        Call IndentModule(NameOfModule:=arListOfCodeModules(iLoop))
      Next iLoop
    End If
    Erase arListOfCodeModules
    
    MsgBox Prompt:="Done", Buttons:=vbExclamation, Title:="VBA Code Indented for file " & gstr_Wbk_Name
    
  End If
  
End Sub
  
Private Sub IndentModule(ByVal NameOfModule As String)
  
  Const IndentStep As Long = 2
  
  Dim blnInitialCommentInModule As Boolean
  Dim blnIndentNextLine As Boolean, blnOutdentNow As Boolean
  Dim blnNoIndent As Boolean
  
  Dim iLoop As Long, HowManyIndents As Long
  Dim strMyCodeLine As String
  Dim vbComp As VBIDE.VBComponent
  Dim vbProj As VBIDE.VBProject
  
  Set vbProj = Workbooks(gstr_Wbk_Name).VBProject
  Set vbComp = vbProj.VBComponents(NameOfModule)
  
  With vbComp.CodeModule
    
    blnNoIndent = False
    blnInitialCommentInModule = True
    blnIndentNextLine = False
    blnOutdentNow = False
    
    For iLoop = 1 To .CountOfLines
      
      strMyCodeLine = Trim$(.Lines(iLoop, 1))
      
      If Len(strMyCodeLine) > 0 Then
        
        Select Case FirstWord(strMyCodeLine)
          
        Case "Option"
          blnNoIndent = True
          
        Case "Declare", "Enum", "Function", "Private", "Public", "Sub", "Type"
          blnNoIndent = True
          blnInitialCommentInModule = False
          
        Case "If", "IIf"
          blnIndentNextLine = True
          If InStr(strMyCodeLine, " Then ") > 0 Then
            If Not Replace$(strMyCodeLine, " ", vbNullString) Like "*Then'*" Then blnIndentNextLine = False
          End If
          blnInitialCommentInModule = False
                
        Case "Do", "For", "Select", "With"
          blnIndentNextLine = True
          blnInitialCommentInModule = False
                
        Case "Case"
          'if PREVIOUS line was not a Select or Case statement, outdent now
          If Len(.Lines(iLoop - 1, 1)) > 0 Then
            If Not FirstWord(Trim$(.Lines(iLoop - 1, 1))) Like "Case" And Not FirstWord(Trim$(.Lines(iLoop - 1, 1))) Like "Select" Then
              blnOutdentNow = True
            End If
          End If
          'if NEXT line is not an End or Case statement, indent next line
          If Len(.Lines(iLoop + 1, 1)) > 0 Then
            If Not FirstWord(Trim$(.Lines(iLoop + 1, 1))) Like "End" And Not FirstWord(Trim$(.Lines(iLoop + 1, 1))) Like "Case" Then
              blnIndentNextLine = True
            End If
          End If
                          
        Case "Else", "ElseIf"
          blnOutdentNow = True
          blnIndentNextLine = True
          blnInitialCommentInModule = False
          
        Case "End"
          If strMyCodeLine Like "End Function*" Or strMyCodeLine Like "End Sub*" Then
            blnNoIndent = True
          End If
          If strMyCodeLine Like "End If*" Or strMyCodeLine Like "End Select*" Or strMyCodeLine Like "End With*" Then
            blnOutdentNow = True
          End If
          blnInitialCommentInModule = False
          
        Case "Loop", "Next"
          blnOutdentNow = True
          blnInitialCommentInModule = False
          
        Case Else
          If FirstWord(strMyCodeLine) Like "*:" Then
            blnNoIndent = True
          End If
            
        End Select
        
      End If
      
      If blnNoIndent Then HowManyIndents = 0
      If blnOutdentNow Then HowManyIndents = HowManyIndents - 1
      
      .ReplaceLine iLoop, String(HowManyIndents * IndentStep, " ") & strMyCodeLine
      
      If HowManyIndents = 0 Then HowManyIndents = 1
      If blnInitialCommentInModule Then HowManyIndents = 0
      If blnIndentNextLine Then HowManyIndents = HowManyIndents + 1
      
      blnNoIndent = False
      blnIndentNextLine = False
      blnOutdentNow = False
      
    Next iLoop
    
  End With
  
  Set vbComp = Nothing
  Set vbProj = Nothing
  
End Sub
  
Private Function FirstWord(ByVal WholeLine As String) As String
  
  Dim ar As Variant
  ar = Split(WholeLine, " ")
  FirstWord = ar(LBound(ar))
  Erase ar
  
End Function
 
Upvote 0
Thanks for this code. I realize this thread is almost a year old, but in case anyone else experiences the same issues I did when trying to implement this, I thought I'd post how I resolved them. My workbook doesn't have a userform named "uf_Workbooks", so it would error out when trying to show the form; I just removed that line. Also, the "gstr_Wbk_Name" string value was never defined, so so I added a line to assign it my current workbook name. Lastly, it kept having an error when attempting to replace line 1 of the VBA code (error code '9'), so I added an "On Error Resume Next" line and it worked fine.

My exact code looks like:
Code:
Option Explicit
Public gstr_Wbk_Name As String

  ' Comments  : Code Indenter
  '
  ' REQUIRED REFERENCE : Microsoft Visual Basic for Applications Extensibility 5.3
  '
  ' Date        Change
  ' ------------------------------------------------
  ' 16-May-13 Created
  ' 16-Jun-16 Fix up handling of "IF *** THEN"
  ' 16-Feb-19 Modified to work for me, source: "http://www.mrexcel.com/forum/excel-questions/802527-replicate-indentervba-exe-com-add.html"
  
  
Sub MyCodeIndenter()
  
  Dim iLoop As Long
  Dim arListOfCodeModules() As String
  Dim vbComp As VBIDE.VBComponent
 
  gstr_Wbk_Name = ActiveWorkbook.Name
  
  If Len(gstr_Wbk_Name) > 0 Then
    
    ReDim arListOfCodeModules(1 To 500)
    For Each vbComp In Application.Workbooks(gstr_Wbk_Name).VBProject.VBComponents
      If vbComp.CodeModule.CountOfLines > 3 Then
        iLoop = iLoop + 1
        arListOfCodeModules(iLoop) = vbComp.Name
      End If
    Next vbComp
    Set vbComp = Nothing
    
    If iLoop > 0 Then
      ReDim Preserve arListOfCodeModules(1 To iLoop)
      For iLoop = LBound(arListOfCodeModules) To UBound(arListOfCodeModules)
        Call IndentModule(NameOfModule:=arListOfCodeModules(iLoop))
      Next iLoop
    End If
    Erase arListOfCodeModules
    
    MsgBox prompt:="Done", Buttons:=vbExclamation, Title:="VBA Code Indented for file " & gstr_Wbk_Name
    
  End If
  
End Sub
  
Private Sub IndentModule(ByVal NameOfModule As String)

  On Error Resume Next
  
  Const IndentStep As Long = 2
  
  Dim blnInitialCommentInModule As Boolean
  Dim blnIndentNextLine As Boolean, blnOutdentNow As Boolean
  Dim blnNoIndent As Boolean
  
  Dim iLoop As Long, HowManyIndents As Long
  Dim strMyCodeLine As String
  Dim vbComp As VBIDE.VBComponent
  Dim vbProj As VBIDE.VBProject
  
  Set vbProj = Workbooks(gstr_Wbk_Name).VBProject
  Set vbComp = vbProj.VBComponents(NameOfModule)
  
  With vbComp.CodeModule
    
    blnNoIndent = False
    blnInitialCommentInModule = True
    blnIndentNextLine = False
    blnOutdentNow = False
    
    For iLoop = 1 To .CountOfLines
      
      strMyCodeLine = Trim$(.lines(iLoop, 1))
      
      If Len(strMyCodeLine) > 0 Then
        
        Select Case FirstWord(strMyCodeLine)
          
        Case "Option"
          blnNoIndent = True
          
        Case "Declare", "Enum", "Function", "Private", "Public", "Sub", "Type"
          blnNoIndent = True
          blnInitialCommentInModule = False
          
        Case "If", "IIf"
          blnIndentNextLine = True
          If InStr(strMyCodeLine, " Then ") > 0 Then
          If Not Replace$(strMyCodeLine, " ", vbNullString) Like "*Then'*" Then blnIndentNextLine = False
          End If
          blnInitialCommentInModule = False
          
        Case "Do", "For", "Select", "With"
          blnIndentNextLine = True
          blnInitialCommentInModule = False
          
        Case "Case"
          'if PREVIOUS line was not a Select or Case statement, outdent now
          If Len(.lines(iLoop - 1, 1)) > 0 Then
            If Not FirstWord(Trim$(.lines(iLoop - 1, 1))) Like "Case" And Not FirstWord(Trim$(.lines(iLoop - 1, 1))) Like "Select" Then
              blnOutdentNow = True
            End If
          End If
          'if NEXT line is not an End or Case statement, indent next line
          If Len(.lines(iLoop + 1, 1)) > 0 Then
            If Not FirstWord(Trim$(.lines(iLoop + 1, 1))) Like "End" And Not FirstWord(Trim$(.lines(iLoop + 1, 1))) Like "Case" Then
              blnIndentNextLine = True
            End If
          End If
          
        Case "Else", "ElseIf"
          blnOutdentNow = True
          blnIndentNextLine = True
          blnInitialCommentInModule = False
          
        Case "End"
          If strMyCodeLine Like "End Function*" Or strMyCodeLine Like "End Sub*" Then
            blnNoIndent = True
          End If
          If strMyCodeLine Like "End If*" Or strMyCodeLine Like "End Select*" Or strMyCodeLine Like "End With*" Then
            blnOutdentNow = True
          End If
          blnInitialCommentInModule = False
          
        Case "Loop", "Next"
          blnOutdentNow = True
          blnInitialCommentInModule = False
          
        Case Else
          If FirstWord(strMyCodeLine) Like "*:" Then
            blnNoIndent = True
          End If
          
        End Select
        
      End If
      
      If blnNoIndent Then HowManyIndents = 0
      If blnOutdentNow Then HowManyIndents = HowManyIndents - 1
      
      .ReplaceLine iLoop, String(HowManyIndents * IndentStep, "  ") & strMyCodeLine
      
      If HowManyIndents = 0 Then HowManyIndents = 1
      If blnInitialCommentInModule Then HowManyIndents = 0
      If blnIndentNextLine Then HowManyIndents = HowManyIndents + 1
      
      blnNoIndent = False
      blnIndentNextLine = False
      blnOutdentNow = False
      
    Next iLoop
    
  End With
  
  Set vbComp = Nothing
  Set vbProj = Nothing
  
End Sub
  
Private Function FirstWord(ByVal WholeLine As String) As String
  
  Dim ar As Variant
  ar = Split(WholeLine, " ")
  FirstWord = ar(LBound(ar))
  Erase ar
  
End Function

My OS: Win7 x32 Enterprise
My Excel: 2013

Best Regards,
~MP
 
Upvote 0

Forum statistics

Threads
1,226,588
Messages
6,191,887
Members
453,684
Latest member
Gretchenhines

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top