Loading
Ozgrid Excel Help & Best Practices Forums

Excel Video Tutorials / Excel Dashboards Reports



Results 1 to 5 of 5

Thread: VBA Code Line Number Writer

  1. #1
    Join Date
    17th November 2008
    Posts
    4

    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

    VB:
    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 
    
    

    Excel Video Tutorials / Excel Dashboards Reports


  2. #2
    Join Date
    24th January 2003
    Location
    Australia
    Posts
    31,717

  3. #3
    Join Date
    13th July 2007
    Posts
    209

    Re: VBA Code Line Number Writer

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

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

    Excel Video Tutorials / Excel Dashboards Reports


  4. #4
    Join Date
    17th November 2008
    Posts
    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.

    VB:
    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 
    
    

    Excel Video Tutorials / Excel Dashboards Reports


  5. #5
    Join Date
    25th July 2011
    Posts
    1

    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

    Excel Video Tutorials / Excel Dashboards Reports


Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Possible Answers

  1. Number Line/Row With Moving Indicator
    By Anupam Shrivastava in forum EXCEL HELP
    Replies: 10
    Last Post: June 3rd, 2008, 11:52
  2. Display Current Code Line Number While Macro Running
    By postman2000 in forum EXCEL HELP
    Replies: 9
    Last Post: September 21st, 2007, 20:08
  3. Report Writer
    By GeoffreyO in forum EXCEL HELP
    Replies: 2
    Last Post: November 22nd, 2005, 13:08
  4. VBA: How do I get the line number?
    By justin72 in forum EXCEL HELP
    Replies: 2
    Last Post: August 6th, 2003, 00:18
  5. [Solved] VBA Code: Debugging a line of code
    By briaNRDonohue in forum EXCEL HELP
    Replies: 3
    Last Post: June 14th, 2003, 04:40

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
porno