Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Loop Though All UDF Names in Project

This question: Searching for function usage in Excel VBA got me thinking about a process for automating a search for all UDFs being used in a spreadsheet. Something along the lines of:

For Each UDF in Module1
    If Cells.Find(What:=UDF.Name, After:="A1", LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False) Then
        MsgBox UDF.Name & " is in use"
    End If
Next UDF

Is this possible and if so, what would the syntax be for looping through all UDFs?

like image 885
Chrismas007 Avatar asked Dec 30 '14 19:12

Chrismas007


2 Answers

Okay, I'm going to do this the hard way, because I'm going to assume that you don't want to have to download the VBE classes from my repository to make this a bit easier to work with, but they're there as an example of what's possible regardless.

First, you'll need to add a reference to the Microsoft Visual Basic for Applications Extensibility 5.3 Library and allow VBA to access the editor by taking the following steps. (Assumes Office 2010)

  1. File
  2. Options
  3. Trust Center
  4. Trust Center Settings
  5. Macro Settings
  6. Check "Trust access to the VBA project object model".

Now we're ready to explore the code in the workbook, but first, some things to remember about what we're looking for here.

  1. Functions
  2. More specifically, Public Functions
  3. In standard *.bas modules (class functions can't be UDFs).
  4. That don't have Option Private Module

The code below works on the active vba project, but could be modified to take one as a parameter. It works with the quick test cases I provided below the Run sub, but I wouldn't guarantee that it works for all corner cases. Parsing is hard. This also just stores and prints the function signatures in the results collection. I imagine in reality you would want a function that returns them, so that you could loop through the collection looking for them in the workbook.

Option Explicit

Private Sub Run()
    Dim results As New Collection

    Dim component As VBIDE.VBComponent
    For Each component In Application.VBE.ActiveVBProject.VBComponents

        If component.Type = vbext_ct_StdModule Then
            ' find public functions with no arguments
            Dim codeMod As CodeModule
            Set codeMod = component.CodeModule

            If InStr(1, codeMod.Lines(1,codeMod.CountOfDeclarationLines), "Option Private Module") = 0 Then

                Dim lineNumber As Long
                lineNumber = codeMod.CountOfDeclarationLines + 1

                Dim procName As String
                Dim procKind As vbext_ProcKind
                Dim signature As String

                ' loop through all lines in the module
                While (lineNumber < codeMod.CountOfLines)
                    procName = codeMod.ProcOfLine(lineNumber, procKind) 'procKind is an OUT param

                    Dim lines() As String
                    Dim procLineCount As Long

                    procLineCount = codeMod.ProcCountLines(procName, procKind)
                    lines = Split(codeMod.lines(lineNumber, procLineCount), vbNewLine)

                    Dim i As Long
                    For i = 0 To UBound(lines)
                        If lines(i) <> vbNullString And Left(Trim(lines(i)), 1) <> "'" Then
                            signature = lines(i)
                            Exit For
                        End If
                    Next

                    ' this would need better parsing, but should be reasonably close
                    If InStr(1, signature, "Public Function", vbTextCompare) > 0 Then 'first make sure we have a public function
                        results.Add signature
                    End If

                    lineNumber = lineNumber + procLineCount + 1 ' skip to next procedure
                Wend

            End If

        End If
    Next component

    Dim str
    For Each str In results
        Debug.Print str
    Next
End Sub

Public Function foo()

End Function

Private Function bar()

End Function

Public Function qwaz(duck)

End Function
like image 179
RubberDuck Avatar answered Oct 09 '22 06:10

RubberDuck


Option Explicit

' Add reference to Microsoft Visual Basic for Applications Extensibility 5.3 Library

Public Sub FindFunctionUsage()
    Dim udfs
    udfs = ListProcedures("Module1")
    If Not IsArray(udfs) Then _
        Exit Sub

    Dim udf
    Dim findResult

    For Each udf In udfs
        Set findResult = Cells.Find(What:="=" & udf, After:=Cells(1), LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False)

        If Not findResult Is Nothing Then _
            MsgBox udf & " is in use"
    Next udf
End Sub

' Source for ListProcedures : http://www.cpearson.com/excel/vbe.aspx
Private Function ListProcedures(moduleName As String)
        Dim VBProj As VBIDE.VBProject
        Dim VBComp As VBIDE.VBComponent
        Dim CodeMod As VBIDE.CodeModule
        Dim LineNum As Long
        Dim NumLines As Long
        Dim WS As Worksheet
        Dim rng As Range
        Dim ProcName As String
        Dim ProcKind As VBIDE.vbext_ProcKind

        Set VBProj = ActiveWorkbook.VBProject
        Set VBComp = VBProj.VBComponents(moduleName)
        Set CodeMod = VBComp.CodeModule

        Dim result
        With CodeMod
            LineNum = .CountOfDeclarationLines + 1
            Do Until LineNum >= .CountOfLines
                ProcName = .ProcOfLine(LineNum, ProcKind)
                If ProcKindString(ProcKind) = "Sub Or Function" Then
                    If IsArray(result) Then
                        ReDim Preserve result(LBound(result) To UBound(result) + 1)
                    Else
                        ReDim result(0 To 0)
                    End If
                    result(UBound(result)) = ProcName
                End If

                LineNum = .ProcStartLine(ProcName, ProcKind) + _
                        .ProcCountLines(ProcName, ProcKind) + 1
            Loop
        End With
        ListProcedures = result
    End Function

    Function ProcKindString(ProcKind As VBIDE.vbext_ProcKind) As String
        Select Case ProcKind
            Case vbext_pk_Get
                ProcKindString = "Property Get"
            Case vbext_pk_Let
                ProcKindString = "Property Let"
            Case vbext_pk_Set
                ProcKindString = "Property Set"
            Case vbext_pk_Proc
                ProcKindString = "Sub Or Function"
            Case Else
                ProcKindString = "Unknown Type: " & CStr(ProcKind)
        End Select
    End Function

' Content of Module1
Public Sub Sub1()

End Sub

Public Function Func1(ByRef x As Range)

End Function

Public Sub Sub2()

End Sub

enter image description here

like image 44
Daniel Dušek Avatar answered Oct 09 '22 05:10

Daniel Dušek