Add-in or VBA code that will Sort VBA Procedures

[GaryR]

Does anyone know of a VBA add-in (like Smart Indenter) that will sort VBA Procedures Alphabetically by name?

I keep one module in my personal.xlsb of all my random macros, but I'd like it to be organized. Is there an add-in the will sort your procedures for you without altering them?

Thanks!

so I'd want this...

Sub ABC
code
End Sub
 
Sub BCD
code
End Sub
 
Sub CDE
code
End Sub

 

[GaryR]

bump!

 

[SydneyGeek]

Hi Gary,

Not that I know of. But if you use the navigation drop-down at the top right of the module sheet, the IDE displays a sorted jump-list.

Denis

 

[GaryR]

hi sydneygeek, i see that sorted dropdown. that's helpful - but i really want to have them get sorted into that order preferrably. to make the code as neat as possible.

 

[SydneyGeek]

Chip Pearson's site has code for working with the VBE. That may give you some pointers but I tend to stay way from code that writes code. It can get you into trouble.
My inclination would be to manually order the procedures and then insert new ones as you go; or use the drop-down. I also tend to modularise my code; related procedures on each module. That's a big help because I can go back to an old project and all the pivot table code is in one module, for example. That makes it much more portable.

Denis

 

[GaryR]

i do modules for my projects also, but i'm looking at this mostly for my personal.xlsb file that has my random macros that don't belong to a project.

 

[SydneyGeek]

Nothing stopping you from organising them into categories, and putting those categories into separate modules...

Denis

 

[Colin Legg]

MZ-Tools has a 'Sort Procedures' utility which will let you move procedures around in the module. It won't automatically sort them alphabetically for you though.

 

[GaryR]

that's a cool utility Colin L. It doesn't auto sort, but it definately gets the job done. the other features look like they'll be neat to play with too.

thanks!

 

[alexofrhodes]

You need to refferene the VBA Extendibility. Then :

1. Let's say we want to sort the Procedures for each Component so: Loop through Components
2. For each Component get an array with the Procedures names and sort it
3. For each Procedure get its text and add it to a string variable
4. Replace the Component's text (after the declaration lines) with the string variable

Here is the code :

Sub testSortProcedures()
Call SortProcedures(ActiveWorkbook.Name)
End Sub

Sub SortProcedures(WorkbookName As String)
    Dim FromWorkbook As Workbook
    Set FromWorkbook = Workbooks(WorkbookName)

    Dim vbcomp As VBComponent
    Dim vProceduresList As Variant
    Dim Procedure As Variant
    
    Dim varr
    Dim i As Long
    Dim ReplacedProcedures As String
    Dim StartLine As Long
    Dim TotalLines As Long
    
    For Each vbcomp In FromWorkbook.VBProject.VBComponents
    If vbcomp.CodeModule.CountOfLines = 0 Then GoTo skip
        varr = Split(GetProceduresList(FromWorkbook.Name, vbcomp.Name), vbNewLine)
        StartLine = vbcomp.CodeModule.ProcStartLine(varr(0), vbext_pk_Proc)
        TotalLines = vbcomp.CodeModule.CountOfLines - vbcomp.CodeModule.CountOfDeclarationLines
        Call SortArray(varr, 0, UBound(varr))
        For i = LBound(varr) To UBound(varr)
            If ReplacedProcedures = "" Then
                ReplacedProcedures = _
                GetProcText(FromWorkbook.Name, vbcomp.Name, varr(i))
            Else
                ReplacedProcedures = _
                ReplacedProcedures & vbNewLine & _
                GetProcText(FromWorkbook.Name, vbcomp.Name, varr(i))
            End If
        Next i
        vbcomp.CodeModule.DeleteLines StartLine, TotalLines
        vbcomp.CodeModule.AddFromString ReplacedProcedures
skip:
        ReplacedProcedures = ""
    Next vbcomp
End Sub

Function GetProceduresList(WorkbookName As String, ComponentName As String)
    Dim ProcKind As VBIDE.vbext_ProcKind
    Dim LineNum, NumProc As Long
    Dim ProcName As String
        
    With Workbooks(WorkbookName).VBProject.VBComponents(ComponentName).CodeModule
        LineNum = .CountOfDeclarationLines + 1
        Do Until LineNum >= .CountOfLines
            ProcName = .ProcOfLine(LineNum, ProcKind)
            LineNum = .ProcStartLine(ProcName, ProcKind) + .ProcCountLines(ProcName, ProcKind) + 1
            NumProc = NumProc + 1
                
            If GetProceduresList = "" Then
                GetProceduresList = ProcName
            Else
                GetProceduresList = GetProceduresList & vbNewLine & ProcName
            End If
        Loop
    End With
        
'    Debug.Print "Project "; vbTab; WorkbookName & vbNewLine & _
                "Component "; vbTab; ComponentName & vbNewLine & _
                "Contains "; vbTab; NumProc & " Procedures" & vbNewLine & vbNewLine & _
                GetProceduresList
End Function

Sub testSortArray()
Dim varr
varr = Split("B,C,A", ",")
Call SortArray(varr, 0, UBound(varr))
Dim i As Long
For i = LBound(varr) To UBound(varr)
Debug.Print varr(i)
Next i
End Sub

Public Sub SortArray(vArray As Variant, inLow As Long, inHi As Long)
 'Example: Call SortArray(myArray, 0, UBound(myArray))
  Dim pivot   As Variant
  Dim tmpSwap As Variant
  Dim tmpLow  As Long
  Dim tmpHi   As Long

  tmpLow = inLow
  tmpHi = inHi

  pivot = vArray((inLow + inHi) \ 2)

  While (tmpLow <= tmpHi)
     While (vArray(tmpLow) < pivot And tmpLow < inHi)
        tmpLow = tmpLow + 1
     Wend

     While (pivot < vArray(tmpHi) And tmpHi > inLow)
        tmpHi = tmpHi - 1
     Wend

     If (tmpLow <= tmpHi) Then
        tmpSwap = vArray(tmpLow)
        vArray(tmpLow) = vArray(tmpHi)
        vArray(tmpHi) = tmpSwap
        tmpLow = tmpLow + 1
        tmpHi = tmpHi - 1
     End If
  Wend

  If (inLow < tmpHi) Then SortArray vArray, inLow, tmpHi
  If (tmpLow < inHi) Then SortArray vArray, tmpLow, inHi
End Sub

'---------------------------------------------------------------------------------------
' Procedure : VBE_GetProc
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Return a VBA proc's text - a way to extract vba procedures
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
'             (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: None, uses Late Binding
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sModuleName : Name of the Module that contains the procedure to navigate to
' sProcName   : Name of the procedure to return the text of
' bInclHeader : True/False - whether to include the procedure header in the returned
'                   string
'
' Usage:
' ~~~~~~
' ? VBE_GetProc("Module1", "fOSUserName")
' ? VBE_GetProc("Module1", "fOSUserName", False)
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2018-12-28              Initial Release, forum help
' 2         2018-12-28              Swicthed to Late Binding
' 3         2018-12-31              Added bInclHeader to include/exclude the proc header
'                                   Minor code optimization
'---------------------------------------------------------------------------------------
Public Function GetProcText(ByVal oWB As String, _
                            ByVal sModuleName As String, _
                            ByVal sProcName As String, _
                            Optional bInclHeader As Boolean = True)
    Dim oModule               As Object
    Dim lProcStart            As Long
    Dim lProcBodyStart        As Long
    Dim lProcNoLines          As Long
    Const vbext_pk_Proc = 0
 
    On Error GoTo Error_Handler
 
    Set oModule = Workbooks(oWB).VBProject.VBComponents(sModuleName).CodeModule
    lProcStart = oModule.ProcStartLine(sProcName, vbext_pk_Proc)
    lProcBodyStart = oModule.ProcBodyLine(sProcName, vbext_pk_Proc)
    lProcNoLines = oModule.ProcCountLines(sProcName, vbext_pk_Proc)
    If bInclHeader = True Then
        GetProcText = oModule.Lines(lProcStart, lProcNoLines)
    Else
        lProcNoLines = lProcNoLines - (lProcBodyStart - lProcStart)
        GetProcText = oModule.Lines(lProcBodyStart, lProcNoLines)
    End If
 
Error_Handler_Exit:
    On Error Resume Next
    If Not oModule Is Nothing Then Set oModule = Nothing
    Exit Function
 
Error_Handler:
    'Err 35 is raised if proc not found
    Debug.Print "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: GetProcText" & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, vbNullString, Erl <> 0, vbCrLf & "Line No: " & Erl)
    Resume Error_Handler_Exit
End Function