Announcement

Collapse
No announcement yet.

VBA Code Line Number Writer

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • VBA Code Line Number Writer

    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

  • #2
    Re: Line Number Writer

    That is cool, thanks

    Comment


    • #3
      Re: VBA Code Line Number Writer

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

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

      Comment


      • #4
        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

        Comment


        • #5
          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

          Comment

          Working...
          X