Yodelayheewho
Yodelayheewho

Reputation: 59

Issues extracting complete list of objects and character lengths

I'm a newbie. I discovered Copilot and used it to get the code below. I want to track the number of characters in all objects to keep watch of excessive code, etc. The code lists the Module Name in column 1 and the number of characters in column 2. It works beautifully with one important exception; 1 of the 9 worksheets and 2 of the 9 Userforms are not appearing on the list. The weakness of Copilot is it often can only take you so far. Any idea what's up? Thank you in advance.

My listing looks like this... Image of the current list

Option Explicit

Sub CheckModuleLength()
    Dim ws As Worksheet
    Dim tbl As ListObject

    ' Reference the Legend worksheet
    Set ws = ThisWorkbook.Worksheets("Legend")
    
    ' Create or reference the table
    Set tbl = ws.ListObjects("tblModCharCount")
    On Error GoTo 0
    
    If tbl Is Nothing Then
        ' Create a new table if it doesn't exist
        Set tbl = ws.ListObjects.Add(xlSrcRange, ws.Range("AA2:AB2"), , xlYes)
        tbl.Name = "tblModCharCount"
        tbl.HeaderRowRange(1).Value = "Module Name"
        tbl.HeaderRowRange(2).Value = "Character Count"
    Else
        ' Clear existing table data without changing the style
        If tbl.ListRows.Count > 0 Then tbl.DataBodyRange.Delete
    End If
    
    ' Add ThisWorkbook as its own group
    AddThisWorkbook ws, tbl
    
    ' Organize the output by categories
    WriteModuleLengths ws, tbl, vbext_ct_Document, "Worksheets"
    WriteModuleLengths ws, tbl, vbext_ct_MSForm, "UserForms"
    WriteModuleLengths ws, tbl, vbext_ct_StdModule, "Modules"
    WriteModuleLengths ws, tbl, vbext_ct_ClassModule, "Class Modules"
    
    ' Add overall total at the bottom
    AddOverallTotal ws, tbl
End Sub

Sub AddThisWorkbook(ws As Worksheet, tbl As ListObject)
    Dim vbComp As VBComponent
    Dim codeLines As Long
    Dim charCount As Long
    Dim moduleCode As String
    Dim row As ListRow
    
    ' Find ThisWorkbook component
    For Each vbComp In ThisWorkbook.VBProject.VBComponents
        If vbComp.Name = "ThisWorkbook" Then
            codeLines = vbComp.CodeModule.CountOfLines
            If codeLines > 0 Then
                moduleCode = vbComp.CodeModule.Lines(1, codeLines)
                charCount = Len(moduleCode)
                
                ' Write ThisWorkbook to the table
                Set row = tbl.ListRows.Add
                row.Range(1).Value = "ThisWorkbook"
                row.Range(2).Value = charCount
            End If
            Exit For
        End If
    Next vbComp
End Sub

Sub WriteModuleLengths(ws As Worksheet, tbl As ListObject, moduleType As VBIDE.vbext_ComponentType, category As String)
    Dim vbComp As VBComponent
    Dim codeLines As Long
    Dim charCount As Long
    Dim moduleCode As String
    Dim row As ListRow
    Dim moduleCount As Long
    Dim moduleNames() As String
    Dim charCounts() As Long
    Dim i As Long
    Dim processedComponents As Collection
    
    Set processedComponents = New Collection
    moduleCount = 0
    ReDim moduleNames(1 To 1)
    ReDim charCounts(1 To 1)
    
    ' Collect module names and character counts
    For Each vbComp In ThisWorkbook.VBProject.VBComponents
        On Error Resume Next
        processedComponents.Add vbComp.Name, vbComp.Name
        If Err.Number = 0 Then
            If vbComp.Type = moduleType And vbComp.Name <> "ThisWorkbook" Then
                codeLines = vbComp.CodeModule.CountOfLines
                If codeLines > 0 Then
                    moduleCode = vbComp.CodeModule.Lines(1, codeLines)
                    charCount = Len(moduleCode)
                    
                    moduleCount = moduleCount + 1
                    ReDim Preserve moduleNames(1 To moduleCount)
                    ReDim Preserve charCounts(1 To moduleCount)
                    moduleNames(moduleCount) = vbComp.Name
                    charCounts(moduleCount) = charCount
                End If
            End If
        End If
        On Error GoTo 0
    Next vbComp
    
    ' Sort the module names alphabetically
    Call BubbleSort(moduleNames, charCounts)
    
    ' Write the result to the table
    For i = 1 To moduleCount
        Set row = tbl.ListRows.Add
        row.Range(1).Font.Bold = False
        row.Range(2).Font.Bold = False
        row.Range(1).Value = moduleNames(i)
        row.Range(2).Value = charCounts(i)
    Next i
    
    ' Add subtotal for the category
    Set row = tbl.ListRows.Add
    row.Range(1).Value = "Total: " & moduleCount & " " & category
    row.Range(2).Value = ""
    row.Range.Font.Bold = True
End Sub

Sub AddOverallTotal(ws As Worksheet, tbl As ListObject)
    Dim totalModules As Long
    Dim row As ListRow
    
    totalModules = tbl.ListRows.Count
    
    ' Add overall total at the bottom
    Set row = tbl.ListRows.Add
    row.Range(1).Value = "Overall Total: " & totalModules & " Modules"
    row.Range(2).Value = ""
    row.Range.Font.Bold = True
End Sub

Sub BubbleSort(arr1() As String, arr2() As Long)
    Dim i As Long, j As Long
    Dim temp1 As String
    Dim temp2 As Long
    
    For i = LBound(arr1) To UBound(arr1) - 1
        For j = i + 1 To UBound(arr1)
            If LCase(arr1(i)) > LCase(arr1(j)) Then
                ' Swap arr1
                temp1 = arr1(i)
                arr1(i) = arr1(j)
                arr1(j) = temp1
                ' Swap arr2
                temp2 = arr2(i)
                arr2(i) = arr2(j)
                arr2(j) = temp2
            End If
        Next j
    Next i
End Sub

Upvotes: 0

Views: 13

Answers (0)

Related Questions