I am finding some text within the body of a VBA macro between specific rows and .find resets the row details

66 Views Asked by At

Building upon the success of a previous post: In MS Project how can I list all the sub routines along with their module names
I am using the code from http://www.cpearson.com/excel/vbe.aspx for Searching for text within a macro. I am currently searching for some simple text however eventually I will be looping through a set of text (the sub and function names) and searching for them in each of the subs and functions in each module so that I can report back which macros and functions call other Subs and Functions. The code is:

'.vbVisual Basic
'---------------------------------------------------------------------------------------
' Purpose   :       Prints all subs and functions in a project
' Prerequisites:    Microsoft Visual Basic for Applications Extensibility 5.3 library
'                   CreateLogFile
' How to run:       Run GetFunctionAndSubNames, set a parameter to blnWithParentInfo
'                   If ComponentTypeToString(vbext_ct_StdModule) = "Code Module" Then
'
' Used:             ComponentTypeToString from -> http://www.cpearson.com/excel/vbe.aspx
'---------------------------------------------------------------------------------------

'taken from https://www.vitoshacademy.com/vba-listing-all-procedures-in-all-modules/
'slight modiications to display the module names and customise for MS Project rather than Excel
'changed CreateLogFile to Debug.print
'added choice of how to display the modules

Option Explicit

Private strSubsInfo As String
Public Sub X_GetFunctionAndSubNames()
 
    Dim item            As Variant
    strSubsInfo = ""
    Dim displaychoice As Integer
    
    displaychoice = InputBox("How do you want to display the module names?:" & vbCrLf & "1 = In line with the Procedure Names, seperated by a ':'" & vbCrLf & "2 = The Module name: and then the Procedure names under the Module")
    If Not (displaychoice = 1 Or displaychoice = 2) Then
        MsgBox ("Only 1 or 2 can be chosen, the code will now exit")
        Exit Sub
    End If
    
    For Each item In ThisProject.VBProject.VBComponents 'ThisWorkbook.VBProject.VBComponents
        
        If ComponentTypeToString(vbext_ct_StdModule) = "Code Module" Then
            ListProcedures item.Name, displaychoice, False
            'Debug.Print item.CodeModule.Lines(1, item.CodeModule.CountOfLines)
        End If
        
    Next item
    Debug.Print strSubsInfo
    Chain_slack.Clipboard (strSubsInfo)
    MsgBox ("The procedure and module names have been printed to the Immediate window and has been saved to the Clipboard")
    'CreateLogFile strSubsInfo
End Sub

Private Sub ListProcedures(strName As String, displaychoice As Integer, Optional blnWithParentInfo = False)

    'Microsoft Visual Basic for Applications Extensibility 5.3 library is needed for this to run.

    Dim VBProj          As VBIDE.VBProject
    Dim VBComp          As VBIDE.VBComponent
    Dim CodeMod         As VBIDE.CodeModule
    Dim LineNum         As Long
    Dim ProcName        As String
    Dim ModuleName As String
    Dim ProcKind        As VBIDE.vbext_ProcKind
    Dim Start_row As Long
    Dim End_row As Long
    Dim FindThis As String
    

    Set VBProj = ThisProject.VBProject  'ActiveWorkbook.VBProject
    Set VBComp = VBProj.VBComponents(strName)
    Set CodeMod = VBComp.CodeModule
    ModuleName = VBComp.CodeModule.Name
    FindThis = "find this here"
    
    If displaychoice = 2 Then strSubsInfo = strSubsInfo & IIf(strSubsInfo = vbNullString, vbNullString, vbCrLf) & "Module - " & ModuleName
    
    With CodeMod
        LineNum = .CountOfDeclarationLines + 1
        
        Do Until LineNum >= .CountOfLines
            ProcName = .ProcOfLine(LineNum, ProcKind)
            Start_row = LineNum
            End_row = Start_row + .ProcCountLines(ProcName, ProcKind) + 1
           
            If blnWithParentInfo Then
                If displaychoice = 2 Then strSubsInfo = strSubsInfo & IIf(strSubsInfo = vbNullString, vbNullString, vbCrLf) & strName & "." & ProcName
                If displaychoice = 1 Then strSubsInfo = strSubsInfo & IIf(strSubsInfo = vbNullString, vbNullString, vbCrLf) & strName & "." & ProcName & " : " & ModuleName
            Else
                If displaychoice = 2 Then strSubsInfo = strSubsInfo & IIf(strSubsInfo = vbNullString, vbNullString, vbCrLf) & ProcName
                If displaychoice = 1 Then strSubsInfo = strSubsInfo & IIf(strSubsInfo = vbNullString, vbNullString, vbCrLf) & ProcName & " : " & ModuleName
            End If

            LineNum = .ProcStartLine(ProcName, ProcKind) + .ProcCountLines(ProcName, ProcKind) + 1
            'within this loop can I use the search sub (turned into a functon) from http://www.cpearson.com/excel/vbe.aspx to look from the start line to the end line of this proc
            'and loop thorugh an array or string (easier to transfer fom the starting function?) to see if the proc contains any of the names in the string/array?
'start with a simple term which has been seeded through the project in known places before starting to loop through the various search terms
            
            If SearchCodeModule(ModuleName, Start_row, End_row, FindThis) = True Then Debug.Print ModuleName & ": " & ProcName & " contains " & FindThis & "  " & Start_row & "-" & End_row
                    
        Loop
    End With
End Sub

Function ComponentTypeToString(ComponentType As VBIDE.vbext_ComponentType) As String
    'ComponentTypeToString from http://www.cpearson.com/excel/vbe.aspx
    Select Case ComponentType
    
        Case vbext_ct_ActiveXDesigner
            ComponentTypeToString = "ActiveX Designer"
            
        Case vbext_ct_ClassModule
            ComponentTypeToString = "Class Module"
            
        Case vbext_ct_Document
            ComponentTypeToString = "Document Module"
            
        Case vbext_ct_MSForm
            ComponentTypeToString = "UserForm"
            
        Case vbext_ct_StdModule
            ComponentTypeToString = "Code Module"
            
        Case Else
            ComponentTypeToString = "Unknown Type: " & CStr(ComponentType)
            
    End Select
    
End Function

Function SearchCodeModule(module_name As String, SL As Long, EL As Long, FindWhat As String)
'from http://www.cpearson.com/excel/vbe.aspx
'should be returning a true or false 

    Dim VBProj As VBIDE.VBProject
    Dim VBComp As VBIDE.VBComponent
    Dim CodeMod As VBIDE.CodeModule
    'Dim FindWhat As String
    'Dim SL As Long ' start line
    'Dim EL As Long ' end line
    Dim SC As Long ' start column
    Dim EC As Long ' end column
    Dim Found As Boolean
    
    Set VBProj = ThisProject.VBProject
    Set VBComp = VBProj.VBComponents(module_name)
    Set CodeMod = VBComp.CodeModule
    
    'FindWhat = "findthis"
    
    With CodeMod
        'SL = 1
        'EL = .CountOfLines
        SC = 1
        EC = 255
        Found = .Find(target:=FindWhat, StartLine:=SL, StartColumn:=SC, _
            EndLine:=EL, EndColumn:=EC, _
            wholeword:=True, MatchCase:=False, patternsearch:=False)
        'Do Until Found = False
        '    Debug.Print "Found at: Line: " & CStr(SL) & " Column: " & CStr(SC)
        '    EL = .CountOfLines
        '    SC = EC + 1
        '    EC = 255
        '    Found = .Find(target:=FindWhat, StartLine:=SL, StartColumn:=SC, _
        '        EndLine:=EL, EndColumn:=EC, _
        '        wholeword:=True, MatchCase:=False, patternsearch:=False)
        'Loop
    End With  'why are SL and EL set to equal the location of the string and also the values for StartLine and EndLine are set to the same; how can I keep these for the next loop?
    SearchCodeModule = Found  'Debug.Print Found
End Function

At the point it enters the loop in Sub ListProcedures the start and finish of the row for the current procedure is noted in Start_row and End_row. These values are passsed to the Seach function to limit the search area within each Module. The issue is that when the Search function finds a match (i.e. Found = True) the values for SL, EL, Start_Row and End_row all become the row at which the searched for text is found. This is an issue as in the future when I am looping through all the possible search strings I will need Start_row and End_row to stay the same. Why is it doing this and how to I fix it? :) Many thanks for helping my continued education.

1

There are 1 best solutions below

3
Rachel Hettinger On BEST ANSWER

To report which macros and functions call other Subs and Functions

Public Sub X_GetFunctionAndSubNames()
 
    Dim vbProj As VBIDE.VBProject
    Set vbProj = ThisProject.VBProject
    
    Dim Item As VBIDE.VBComponent
    For Each Item In vbProj.VBComponents
        
        If Item.Type = vbext_ct_StdModule Then
            Dim SubsInfo As String
            SubsInfo = SubsInfo & vbCrLf & ListProcedures(vbProj, Item)
        End If
        
    Next Item
    
    Debug.Print SubsInfo
    'Chain_slack.Clipboard (SubsInfo)
    MsgBox "The procedure and module names have been printed to the Immediate window and has been saved to the Clipboard"
    
End Sub

Function ListProcedures(vbProj As VBIDE.VBProject, module As VBIDE.VBComponent) As String

    Dim modInfo As String
    modInfo = module.Name
    
    Dim ProcKind As VBIDE.vbext_ProcKind
    ProcKind = vbext_pk_Proc
    
    With module.CodeModule
        Dim LineNum As Long
        LineNum = .CountOfDeclarationLines + 1
        
        Do Until LineNum >= .CountOfLines

            Dim procName As String
            procName = .ProcOfLine(LineNum, ProcKind)
           
            modInfo = modInfo & vbCrLf & vbTab & procName & FindCalls(vbProj, procName)
            
            LineNum = .ProcStartLine(procName, ProcKind) + .ProcCountLines(procName, ProcKind) + 1
                    
        Loop
    End With
    
    ListProcedures = modInfo
    
End Function


Function FindCalls(vbProj As VBIDE.VBProject, procName As String) As String

    Dim VBComp As VBIDE.VBComponent
    For Each VBComp In vbProj.VBComponents
    
        If VBComp.Type = vbext_ct_StdModule Then
            With VBComp.CodeModule
                
                Dim callInfo As String
                Dim SL As Long
                SL = 0

                Do Until Not .Find(procName, SL, 0, .CountOfLines, 0, WholeWord:=True)
                    
                    Dim foundIn As String
                    foundIn = .ProcOfLine(SL, vbext_pk_Proc)
                    
                    If procName <> foundIn And Len(foundIn) > 0 Then
                        callInfo = callInfo & vbCrLf & vbTab & vbTab & "called by " & foundIn & " on line " & SL
                    End If
                    SL = SL + 1
                    
                Loop
                
            End With
        End If
    Next VBComp
    
    FindCalls = callInfo
    
End Function

Output

Procedure names are shown indented below the module name and then indented under that is the list of where they are called.

BuildVBAModel
    X_GetFunctionAndSubNames
    ListProcedures
        called by X_GetFunctionAndSubNames on line 14
    FindCalls
        called by ListProcedures on line 42
Module2
    MainProc
    Func1
        called by MainProc on line 6
        called by MainProc on line 11
    ProcB
        called by MainProc on line 8
        called by MainProc on line 13