code line numbers VBA

[iknowu99]

Hi All reading this,

Can't figure out if there is a way to see line numbers in Modules/code?

Gracias

 

[gimiwan]

I'd like to thank mikerickson. His code was a great starting point. I made some modifications to improve robustness. What follows is a list of issues with mikerickson's code that my modifications have corrected:

• Large numbers of modules made the form difficult to use. (Thank you, JayKilleen)
• Line number added on procedure declaration in some circumstances.
• Line number added on procedure End declaration for last procedure in a module if there are blank lines at the end.
• Did not work with Select Case statements. (For some reason, you can't have a label in front of the first case statement.)
• Did not support Property procedures. (Though it took me a while to figure out, the solution was actually very simple.)
• Did not support Class modules. (Presumably he excluded them because it didn't support Properties.)

My code also includes a conditional that excludes line numbers from blank lines and comments. As this is a personal preference that many may not like, I've commented it out. If you would like to use this feature, simply uncomment the if/end if statements.

Mikerickson's preface (mostly) holds true for my code as well:

Open a new workbook. Insert a normal module, named Module1 and put this code in it.
Insert a userform, named Userform1 and insert the code below in its code module.
Run the MakeUF module and you can add and remove line numbers from any code module of any open, unhidden workbook.

 'in normal Module1
Option Explicit

Sub MakeUF()
    With UserForm1
        .Tag = "Choose a code module"
        .Show
    End With
End Sub

Sub AddLineNumbers(wbName As String, vbCompName As String)
    Dim i As Long, j As Long, lineN As Long
    Dim procName As String
    Dim startOfProceedure As Long
    Dim lengthOfProceedure As Long
    Dim newLine As String
    Dim bSelect As Boolean
    Dim procKind As vbext_ProcKind
   
    With Workbooks(wbName).VBProject.VBComponents(vbCompName).CodeModule
        .codePane.Window.Visible = False
        
        For i = .CountOfLines To 1 Step -1
            If Len(Trim$(.Lines(i, 1))) = 0 Then
                .DeleteLines i
            Else
                Exit For
            End If
        Next
        
        For i = 1 To .CountOfLines
            procName = .ProcOfLine(i, procKind)
            
            If ProcName <> vbNullString Then
                startOfProceedure = .ProcStartLine(procName, procKind)
                lengthOfProceedure = .ProcCountLines(procName, procKind)
                
                If i <> .ProcBodyLine(procName, procKind) And i < startOfProceedure + lengthOfProceedure - 1 Then
                    newLine = RemoveOneLineNumber(.Lines(i, 1))
                    If Not HasLabel(newLine) And Not (.Lines(i - 1, 1) Like "* _") Then
                        'If Left$(LTrim$(newLine), 1) <> "'" And LenB(LTrim$(newLine)) <> 0 Then
                            If Left$(LTrim$(newLine), 11) = "Select Case" Then
                                bSelect = True
                            End If
                            If bSelect And Left$(LTrim$(newLine), 4) = "Case" Then
                                bSelect = False
                            Else
                                .ReplaceLine i, CStr(i) & ":" & newLine
                            End If
                        'End If
                    End If
                End If
            End If
        
        Next i
        .codePane.Window.Visible = True
    End With
End Sub

Sub RemoveLineNumbers(wbName As String, vbCompName As String)
    Dim i As Long
    With Workbooks(wbName).VBProject.VBComponents(vbCompName).CodeModule
        For i = 1 To .CountOfLines
            .ReplaceLine i, RemoveOneLineNumber(.Lines(i, 1))
        Next i
    End With
End Sub

Function RemoveOneLineNumber(aString)
    Dim lLabEnd As Long
    
    RemoveOneLineNumber = aString
    lLabEnd = InStr(aString, ":")
    
    If lLabEnd > 0 Then
        If IsNumeric(Left$(aString, lLabEnd - 1)) Then
            RemoveOneLineNumber = Mid$(aString, 1 + lLabEnd)
        End If
    End If
End Function

Function HasLabel(ByVal aString As String) As Boolean
    HasLabel = InStr(1, aString & ":", ":") < InStr(1, aString & " ", " ")
End Function

'in Userform1 code module
Option Explicit

Public WithEvents aListBox As MSForms.ListBox
Public WithEvents butOK As MSForms.CommandButton
Public WithEvents butCancel As MSForms.CommandButton
Public WithEvents butRemove As MSForms.CommandButton

Dim promptLabel As MSForms.Label

Private Sub aListBox_Click()
    butOK.Enabled = True
    butRemove.Enabled = True
End Sub

Private Sub butCancel_Click()
    Me.Tag = vbNullString
    Unload Me
End Sub

Private Sub butOK_Click()
    With aListBox
        If .ListIndex <> -1 Then
            Call AddLineNumbers(.Value, .Text)
        End If
    End With
    butOK.Enabled = False
    butRemove.Enabled = True
    aListBox.SetFocus
End Sub

Private Sub butRemove_Click()
    With aListBox
        If .ListIndex <> -1 Then
            Call RemoveLineNumbers(.Value, .Text)
        End If
    End With
    butRemove.Enabled = False
    butOK.Enabled = True
    aListBox.SetFocus
End Sub

Private Sub UserForm_Activate()
    Dim oneWorkbook As Workbook
    Dim oneComponent As VBComponent
    Dim oneCodeModule As CodeModule
    Dim sizeLabel As MSForms.Label
    Dim fontName As String, fontSize As Long
    fontName = "Arial": fontSize = 12

    Set promptLabel = Me.Controls.Add("Forms.Label.1")
    With promptLabel
        With .Font
            .Name = fontName: .Size = fontSize + 2
        End With
        .BorderStyle = fmBorderStyleNone
        .Top = 5
        .Left = 10
        .Width = 400
        .Caption = Me.Tag
        .AutoSize = True
        .WordWrap = True
        .Width = 400
    End With

    Set aListBox = Me.Controls.Add("Forms.ListBox.1")
    With aListBox
        .Top = promptLabel.Top + promptLabel.Height + 10
        .Left = promptLabel.Left
        .Width = 400
        .Height = 100
        .ColumnCount = 2
        .BoundColumn = 1: .TextColumn = 2
        With .Font
            .Name = fontName
            .Size = fontSize
        End With
    End With
    Set sizeLabel = Me.Controls.Add("Forms.Label.1")
    With sizeLabel
        With .Font
            .Name = fontName
            .Size = fontSize
        End With
        .AutoSize = True
        .Visible = False
    End With

    For Each oneWorkbook In Application.Workbooks
        If oneWorkbook.Windows(1).Visible Then
            For Each oneComponent In oneWorkbook.VBProject.VBComponents
                If Not ((oneWorkbook.Name = ThisWorkbook.Name And oneComponent.Name = "UserForm1") _
                  Or (oneWorkbook.Name = ThisWorkbook.Name And oneComponent.Name = "Module1")) Then
                  
                    aListBox.AddItem oneWorkbook.Name
                    aListBox.List(aListBox.ListCount - 1, 1) = oneComponent.Name
                    sizeLabel.Caption = sizeLabel.Caption & vbCr & "X"
                End If
            Next oneComponent
        End If
    Next oneWorkbook

    aListBox.Height = sizeLabel.Height
    If aListBox.Height > 300 Then
        aListBox.Height = 300
    End If
    
    Me.Controls.Remove sizeLabel.Name

    Set butOK = Me.Controls.Add("Forms.CommandButton.1")
    With butOK
        With .Font
            .Name = fontName
            .Size = fontSize + 2
        End With
        .Default = True
        .AutoSize = True
        .Caption = "Add line labels"
        .AutoSize = False
        .Height = .Height - 4
        .Top = aListBox.Top + aListBox.Height + 16
        .Left = aListBox.Left + aListBox.Width - .Width
    End With

    Set butRemove = Me.Controls.Add("Forms.CommandButton.1")
    With butRemove
        With .Font
            .Name = fontName
            .Size = butOK.Font.Size
        End With
        .Caption = "Remove"
        .Width = butOK.Width
        .Height = butOK.Height
        .Top = butOK.Top
        .Left = butOK.Left - .Width - 20
    End With

    Set butCancel = Me.Controls.Add("Forms.CommandButton.1")
    With butCancel
        With .Font
            .Name = fontName
            .Size = butOK.Font.Size
        End With
        .Caption = "Close"
        .Height = butOK.Height
        .Width = butOK.Width
        .Top = butOK.Top
        .Left = butRemove.Left - .Width - 20
    End With

    With Me
        .Width = 2 * aListBox.Left + aListBox.Width
        .Height = butOK.Top + 2 * butOK.Height + 10
    End With
    
    butOK.Enabled = False
    butRemove.Enabled = False
    aListBox.SetFocus
End Sub

***Note: requires reference to Microsoft Visual Basic for Applications Extensibility 5.3


What I found worked best for me was to put this code into my PERSONAL.XLSB file. I then added a button to the VBE toolbar (using this code from Chip Pearson) so I can easily run this at any time.