List all subs into listbox

[yinkajewole]

how can i list all the subs in my project into a listbox and then run the subs from the listbox?

 

[pgc01]

Hi

To get the names of all subs in your project you have to use the VBA Extensibility Model

You can learn it here:

http://www.cpearson.com/Excel/vbe.aspx

Check in the page:

Listing All Modules In A Project
Listing All Procedures In A Module

If I understand correctly after you have the names of the subs in the ListBox you want to execute them

To execute a sub given its name as a string you can use:

Application.Run "SomeSub"

 

[yinkajewole]

I've gone through it
(1) It can't list all the subs only (it always include functions, which I don't want)
(2) It can't list all the subs in the whole workbook (it only list from one module)

 

[Yongle]

Here is link to code that could be modified
- it lists all procedures(all modules) in a new worksheet
- rename prodeures that you want so that the name always begins with the same text
- modify the code to exclude what you do not want or filter them out when adding to listbox
etc

https://excel.tips.net/T002715_Generating_a_List_of_Macros.html

 

[mikerickson]

I create a floating CommandBar to call my subs from. It doesn't require activating the Microsoft Visual Basic For Applications Extensibility library.

This version make the menu bar for the subs I specify.

Sub makeCommandBar()
    Dim newBar As CommandBar
    On Error Resume Next
        Application.CommandBars("MyFloatingMenu").Delete
    On Error GoTo 0
    Set newBar = Application.CommandBars.Add("MyFloatingMenu", Position:=msoBarFloating, temporary:=True)
    With newBar
        .Width = 135
        
        With .Controls.Add(Type:=msoControlButton, temporary:=True)
            .BeginGroup = True
            .Style = msoButtonCaption
            .Caption = "Get From Spotify"
            .Visible = True
            .OnAction = "GetFromSpotify"
            .Width = 130
        End With
        
        With .Controls.Add(Type:=msoControlButton, temporary:=True)
            .BeginGroup = False
            .Style = msoButtonCaption
            .Caption = "iTunes import"
            .Visible = True
            .OnAction = "ImportFromITunes"
            .Width = 130
        End With
        
        With .Controls.Add(Type:=msoControlButton, temporary:=True)
            .BeginGroup = True
            .Style = msoButtonCaption
            .Caption = "Spotify Rating"
            .Visible = True
            .OnAction = "ShowRating"
            .Width = 130
        End With
        
        With .Controls.Add(Type:=msoControlButton, temporary:=True)
            .BeginGroup = True
            .Style = msoButtonCaption
            .Caption = "TimeRemain formula"
            .Visible = True
            .OnAction = "TimeLeftFormula"
            .Width = 135
        End With
        
        With .Controls.Add(Type:=msoControlButton, temporary:=True)
            .BeginGroup = True
            .Style = msoButtonCaption
            .Caption = "Ordering Userform"
            .Visible = True
            .OnAction = "showOrderForm"
            .Width = 130
        End With
        
        .Top = 200
        .Left = 900
        .Visible = True
    End With
    
End Sub

Alternatly, one could read the modules and create a menu bar for all subs, except the excluded ones.

Sub ReadAndMakeCommandBar()
    Dim newBar As CommandBar
    Dim ArrNames As Variant, i As Long
    ArrNames = ListOfSubs
    For i = 1 To UBound(ArrNames)
        ArrNames(i) = Replace(ArrNames(i), "()", vbNullString)
        ArrNames(i) = Split(ArrNames(i), "Sub ")(1)
    Next i
    MsgBox RRayStr(ArrNames, vbCr)
    
    On Error Resume Next
        Application.CommandBars("MyFloatingMenu").Delete
    On Error GoTo 0
    Set newBar = Application.CommandBars.Add("MyFloatingMenu", Position:=msoBarFloating, temporary:=True)
    
    With newBar
        .Width = 135
        
        For i = 1 To UBound(ArrNames)
            Select Case LCase(ArrNames(i))
            Case "readandmakecommandbar", "makecommandbar"
                Rem do nothing
            Case Else
                Rem make a button
                With .Controls.Add(Type:=msoControlButton, temporary:=True)
                    .Style = msoButtonCaption
                    .Caption = ArrNames(i)
                    .Visible = True
                    .OnAction = ArrNames(i)
                    .Width = 130
                End With
            End Select
        Next i
        
        .Top = 200
        .Left = 900
        .Visible = True
    End With

End Sub

Function ListOfSubs() As Variant
    Dim oneVBComp As VBComponent
    Dim oneModule As CodeModule
    Dim xStr As String, i As Long
    Dim arrSubNames() As String, SubCount As Long
    ReDim arrSubNames(1 To 1)
    With ThisWorkbook.VBProject
        For Each oneVBComp In .VBComponents
            With oneVBComp
                If .Type = vbext_ct_StdModule Then
                    With .CodeModule
                        For i = 1 To .CountOfLines
                            If .Lines(i, 1) Like "*Sub *()" Then
                                SubCount = SubCount + 1
                                If UBound(arrSubNames) < SubCount Then ReDim Preserve arrSubNames(1 To 2 * SubCount)
                                arrSubNames(SubCount) = .Lines(i, 1)
                            End If
                        Next i
                    End With
                End If
            End With
        Next oneVBComp
    End With
    If SubCount > 0 Then
        ReDim Preserve arrSubNames(1 To SubCount)
    Else
        ReDim arrSubNames(0 To 0)
    End If
    ListOfSubs = arrSubNames
End Function

If, in the function ListOfSubs, you change the definition of the VBComponent and CodeModule to Object, you might not need to activate that reference.
(The explicit listing method of MakeCommandBar does not need that reference.)

 

[My Aswer Is This]

I would think the easy way would be to load all your Sub's into a ListBox like this.
And then use this script.

Private Sub CommandButton1_Click()
'Modified  8/14/2019  9:17:49 PM  EDT
    With ListBox1
        .AddItem "One"
        .AddItem "Two"
        .AddItem "Three"
    End With
End Sub
Private Sub ListBox1_Click()
Application.Run ListBox1.Value
End Sub

Sub One()
MsgBox "One"
End Sub
Sub Two()
MsgBox "Two"
End Sub
Sub Three()
MsgBox "Three"
End Sub