VBA Code Line Number Writer

jeffkstephens · Nov 19th 2008

Copy and paste your entire vba project that needs line numbers into activesheet cell A1.
Run writeLineNumbers.
Copy and paste column A & B back into your original project that needed line numbers. Voila, line numbers and (probably) no syntax errors.

It won't work if you have more than 3250 or so lines of code unless you dim linenum variables as long instead of int.

Please post any improvements, suggestions or problems. It could start over at 10 every time it encounters a new subroutine, or ignore end ifs and other lines that won't cause err msg, etc

Code

Sub writeLineNumbers()
    Dim rw As Range
    Dim lineNum As Integer
    Dim previousRwNum As Integer
    
    lineNum = 10
    previousRwNum = 2
    Cells(1, 1).EntireColumn.Insert
    
    For Each rw In Rows("1:" & LastRow)
        If rw.Row > 1 Then previousRwNum = rw.Row - 1
        If Len(Cells(rw.Row, 2).Value) = _
          Len(Cells(rw.Row, 2).Value) - Len(WorksheetFunction.Substitute(Cells(rw.Row, 2).Value, " ", "")) Then _
          Cells(rw.Row, 2).ClearContents
        If WorksheetFunction.CountBlank(Range(Cells(rw.Row, 2), Cells(rw.Row, 21))) <> 20 And _
          WorksheetFunction.CountIf(Range(Cells(previousRwNum, 2), Cells(previousRwNum, 21)), "* _*") = 0 And _
          WorksheetFunction.CountIf(Range(Cells(rw.Row, 2), Cells(rw.Row, 21)), "*Dim *") = 0 And _
          WorksheetFunction.CountIf(Range(Cells(rw.Row, 2), Cells(rw.Row, 21)), "'*") = 0 And _
          WorksheetFunction.CountIf(Range(Cells(rw.Row, 2), Cells(rw.Row, 21)), "*On Error*") = 0 And _
          Left(Cells(rw.Row, 2).Value, 3) <> "Sub" And _
          Left(Cells(rw.Row, 2).Value, 11) <> "Private Sub" And _
          Left(Cells(rw.Row, 2).Value, 8) <> "Function" And _
          Left(Cells(rw.Row, 2).Value, 12) <> "End Function" And _
          Left(Cells(rw.Row, 2).Value, 7) <> "End Sub" Then
            If lineNum = 10 Then
                Cells(rw.Row, 1).Value = lineNum
                lineNum = lineNum + 10
            Else
                Cells(rw.Row, 1).Value = "=add10(A:A)"
                lineNum = lineNum + 10
            End If
        End If
    Next rw
End Sub


Function LastRow() As Long
     LastRow = Cells.Find(What:="*", After:=[A1], _
              SearchOrder:=xlByRows, _
              SearchDirection:=xlPrevious).Row
End Function


Function add10(inRange As Range) As Integer
    add10 = inRange.Find(What:="*", After:=Application.ThisCell, _
              SearchOrder:=xlByRows, _
              SearchDirection:=xlPrevious).Value + 10
End Function

Display More

Dave Hawley · Nov 19th 2008

Re: Line Number Writer

That is cool, thanks

Fencliff · Nov 21st 2008

Re: VBA Code Line Number Writer

MZ-Tools does this within VBE, and so much more.

http://www.mztools.com/v3/download.aspx

jeffkstephens · Nov 24th 2008

Re: VBA Code Line Number Writer

Thanks Fencliff. For whatever reason I didn't hit on that site while I googled for a freeware solution, so I just made one myself.

Oh well.

Anyway, if you still want to do it the HARD way (or your network policy won't let you install add-ins), here's a prettier version that also fixes Select Case statements.

Code

Dim lineNum As Integer
Dim rw As Range


Sub lineNumbers()
    Dim previousRwNum As Integer, selectCaseRw As Integer, selectCount As Integer
    Dim insideSelect As Boolean
    
    lineNum = 10
    previousRwNum = 0
    Cells(1, 1).EntireColumn.Insert
    
    For Each rw In Rows("1:" & LastRow)
'Set row # for previous row above current row, if previous row exists
        If rw.Row > 1 Then previousRwNum = rw.Row - 1
        
'Clear line of code if it contains only spaces
        If Len(Cells(rw.Row, 2).Value) = Len(Cells(rw.Row, 2).Value) - Len(WorksheetFunction.Substitute(Cells(rw.Row, 2).Value, " ", "")) Then _
          Cells(rw.Row, 2).ClearContents


'Conditions for whether a line number gets written
        If previousRwNum = 0 Then 'then don't look for " _" in previous row, row does not exist
            If IsEmpty(Cells(rw.Row, 2)) = False And _
              Right(Trim(Cells(rw.Row, 2).Value), 1) <> ":" And _
              Left(Trim(Cells(rw.Row, 2).Value), 3) <> "Dim" And _
              Left(Trim(Cells(rw.Row, 2).Value), 1) <> "'" And _
              Left(Trim(Cells(rw.Row, 2).Value), 8) <> "On Error" And _
              Left(Trim(Cells(rw.Row, 2).Value), 6) <> "Option" And _
              Left(Trim(Cells(rw.Row, 2).Value), 3) <> "Sub" And _
              Left(Trim(Cells(rw.Row, 2).Value), 11) <> "Private Sub" And _
              Left(Trim(Cells(rw.Row, 2).Value), 10) <> "Public Sub" And _
              Left(Trim(Cells(rw.Row, 2).Value), 8) <> "Function" And _
              Left(Trim(Cells(rw.Row, 2).Value), 12) <> "End Function" And _
              Left(Trim(Cells(rw.Row, 2).Value), 7) <> "End Sub" Then _
              Call writeLineNumForThisRw
        Else
            If IsEmpty(Cells(rw.Row, 2)) = False And _
              Right(Trim(Cells(previousRwNum, 2).Value), 2) <> " _" And _
              Right(Trim(Cells(rw.Row, 2).Value), 1) <> ":" And _
              Left(Trim(Cells(rw.Row, 2).Value), 3) <> "Dim" And _
              Left(Trim(Cells(rw.Row, 2).Value), 1) <> "'" And _
              Left(Trim(Cells(rw.Row, 2).Value), 8) <> "On Error" And _
              Left(Trim(Cells(rw.Row, 2).Value), 6) <> "Option" And _
              Left(Trim(Cells(rw.Row, 2).Value), 3) <> "Sub" And _
              Left(Trim(Cells(rw.Row, 2).Value), 11) <> "Private Sub" And _
              Left(Trim(Cells(rw.Row, 2).Value), 10) <> "Public Sub" And _
              Left(Trim(Cells(rw.Row, 2).Value), 8) <> "Function" And _
              Left(Trim(Cells(rw.Row, 2).Value), 12) <> "End Function" And _
              Left(Trim(Cells(rw.Row, 2).Value), 7) <> "End Sub" Then _
              Call writeLineNumForThisRw
        End If


'If current row is End Select, remove line numbers between end statement and opening statement
        If Left(Trim(Cells(rw.Row, 2).Value), 11) = "Select Case" Then
            If insideSelect = False Then
                insideSelect = True
                selectCaseRw = rw.Row
                selectCount = 1
            Else
                selectCount = selectCount + 1
            End If
        ElseIf Left(Trim(Cells(rw.Row, 2).Value), 10) = "End Select" Then
            If selectCount > 1 Then
                selectCount = selectCount - 1
            ElseIf selectCount = 1 Then
                insideSelect = False
                Range(Cells(selectCaseRw + 1, 1), Cells(rw.Row, 1)).ClearContents
            End If
        End If
    Next rw
End Sub


Private Sub writeLineNumForThisRw()
'Writes 10 for first line number, otherwise writes function Add10
    If lineNum = 10 Then
        Cells(rw.Row, 1).Value = lineNum
        lineNum = lineNum + 10
    Else
        Cells(rw.Row, 1).Value = "=add10(A:A)"
        lineNum = lineNum + 10
    End If
End Sub


Function LastRow() As Long
     LastRow = Cells.Find(What:="*", After:=[A1], _
              SearchOrder:=xlByRows, _
              SearchDirection:=xlPrevious).Row
End Function


Function add10(inRange As Range) As Integer
'Function finds previous line number and adds 10 (for simpler editing of line numbers)
    add10 = inRange.Find(What:="*", After:=Application.ThisCell, _
              SearchOrder:=xlByRows, _
              SearchDirection:=xlPrevious).Value + 10
End Function

Display More

mikenixon · Jul 25th 2011

Re: VBA Code Line Number Writer

MZ-Tools dont work with Office 2010 64 bit as the author uses VBA 6 , and Office 64 bit is VBA 7 , so thanks Jeff ! ,I'll use it rather than downgrade to Office 32 bit again, or install Office 2007 again!
Cheers
Mike

VBA Code Line Number Writer

Participate now!

Share