VBIDE Challenge #6 - Relocating Dim lines in procedures

VBIDE - Visual Basic for Applications Extensibility 5.3

I am intrigued by the idea of writing code that will report on or edit existing code. Unfortunately I am yet to master the use of VBIDE - my skill level on this is currently little-to-none.

So every so often, I post a new VBIDE challenge hoping that some forum user will solve it for me (either from kindness and/or for the love of the challenge).


Here's challenge #6.

Can we use VBIDE to convert a project from one coding style to another?

In this challenge we are looking at Dims. Some coders prefer to declare these just before they are used, others prefer to place them at the top of the procedure.

[UPDATE - This challenge beaten by romperstomper] Loop through every procedure in ThisWorkbook (with the exception of the VBIDE module) and move any Dim found to the top ( .ProcBodyLine ?) of that procedure. Unskilled though I am, I think this is doable. I'm guessing it would be a good idea to loop from the bottom of each module upwards.

[UPDATE - This challenge beaten by romperstomper] The only drawback I can see would be the Dims would be placed before any comment lines at the top of the procedure. So extra points if you can detect comment lines at the top of a procedure and move the procedural Dims below these.


[UPDATE - This challenge not beaten yet] P.S. For anyone looking for an even more advanced challenge - try converting to the Just In Time coding method. Any Dims in a procedure are moved to the line before the first instance they are used in that procedure.

If it helps, here's what little VBIDE code I have so far.

FYI IDE = Integrated Development Environment. It has nothing to do with the extensibility reference.

Actually, I stand corrected - never bothered to check the class name of the VBExt reference!

Originally Posted by Kyle123

At the risk of already knowing the answer, what's the point?

For the fun of beating a challenge of course! What else?

Wait - you mean what's the practical use? Not a lot. Solving it would help improve your VBIDE skills and also stepping through the code would be educational to me and any other VBIDE learners who read this thread.

Actually there is a (somewhat) practical use. If you code in a certain style and say you need to contribute code to a team project which has strict style guidelines - this would enable you to quickly reformat your code rather than having to do it all manually. Same logic applies to code you source from the web that you need to convert the coding style.

Is the goal worthwhile enough?

As I needed something to do while waiting for a report to run, this should get you most of the way:

Option Explicit

Private Sub CleanUpDeclarations()
'/ Puts variables at the start of a procedure (where they belong)
    Dim VBProj                As Object
    Dim VBComp                As Object
    Dim VBCodeMod             As Object
    Dim strProcName           As String
    Dim strThisModule         As String
    Dim strProcedure          As String
    Dim strModName            As String
    Dim ProcKind              As Long
    Dim lngModLineNo          As Long
    Dim lngStartLine          As Long
    Dim lngNumLines           As Long

    'get name of this module - we dont want to check this
    strThisModule = Application.VBE.ActiveCodePane.CodeModule

    Set VBProj = ThisWorkbook.VBProject

    For Each VBComp In VBProj.VBComponents

        strModName = VBComp.Name

        If strModName <> strThisModule Then
            'Scan through the code module, looking for procedures
            With VBProj.VBComponents(strModName).CodeModule

                If .CountOfDeclarationLines > 0 Then
                    lngModLineNo = .CountOfDeclarationLines
                Else
                    lngModLineNo = 1
                End If

                Do While lngModLineNo < .CountOfLines

                    strProcName = .ProcOfLine(lngModLineNo, ProcKind)

                    If Len(strProcName) = 0 Then
                        lngModLineNo = lngModLineNo + 1
                    Else
                        lngStartLine = .ProcBodyLine(strProcName, ProcKind)
                        lngNumLines = .ProcCountLines(strProcName, ProcKind)
                        strProcedure = SortProc(.Lines(lngStartLine, lngNumLines))
                        .DeleteLines lngStartLine, lngNumLines
                        .InsertLines lngStartLine, strProcedure
                        lngModLineNo = lngModLineNo + .ProcCountLines(strProcName, ProcKind)
                    End If

                Loop

            End With

        End If
    Next VBComp

End Sub

Function SortProc(strProcedure As String) As String
    Dim vLines
    Dim n                     As Long
    Dim strLine               As String
    Dim strDec                As String
    Dim strOut                As String
    Dim bStarted              As Boolean

    vLines = Split(strProcedure, vbCrLf)

    For n = LBound(vLines) + 1 To UBound(vLines)
        strLine = Trim$(vLines(n))
        If Left$(LCase$(strLine), 4) = "dim " Then
            bStarted = True
            strDec = strDec & vbCrLf & vbTab & strLine
        Else
            If Not bStarted Then If Left$(strLine, 1) <> "'" _
                    And Left$(LCase$(strLine), 4) <> "rem " _
                    And LenB(strLine) <> 0 Then bStarted = True
                    
            If bStarted Then
                strOut = strOut & vbCrLf & vLines(n)
            Else
                strDec = strDec & vbCrLf & vLines(n)
            End If
        End If
    Next n
    SortProc = vLines(LBound(vLines)) & strDec & vbCrLf & strOut
End Function

Originally Posted by romperstomper

As I needed something to do while waiting for a report to run, this should get you most of the way:

Thanks Rory for what you have done +1

It's almost there. I made up some garbage procedures for testing but when I run your code on it - I get Run-time error -2147024809 'Invalid procedure call or argument' ?

Test procedures below if you are interested in reproducing the error message

Option Explicit

Sub test()

'/ I am a garabage sub
'some more garbage comments
    'leaving first bodyline blank to make the test more difficult
    
    Dim wbk As Excel.Workbook

Dim str As String

            Dim obj As Object

str = "test"

    '   Dim somevariablescanbecommentedout as string


    'Dim i as integer
    Dim rng As Excel.Range

    Dim i2 As Integer
    i2 = 5


    i2 = 5 + 8

    Set wbk = Nothing
End Sub

    Public Function test2() As Variant
'/another test
'some comment lines at top of procedure

    Const str As String = "hi"

Dim lng As Long

    lng = 5486

    Dim byt As Byte
    byt = 24

    test2 = lng + byt

ExitProcedure:

Dim whowouldputadimatbottomofaprocedure
End Function

    strThisModule = Application.VBE.ActiveCodePane.CodeModule

Code sez "oops" if you run that with another module active.

There is apparently no "ThisModule" property?

Originally Posted by shg

    strThisModule = Application.VBE.ActiveCodePane.CodeModule

Code sez "oops" if you run that with another module active.

There is apparently no "ThisModule" property?

I think you are right that there is no "ThisModule" property. However I have never had a problem with using the strThisModule line of code to capture the name of the module containing the VBIDE procedures. Shrug. I run the VBIDE procedures straight from the module pane / i.e. I F5 to start them. How are you running them?

I'm no VBIDE expert by any means but I think that your problem may have something to do with synchronizing the editor? - See the VBIDE page on Chip Pearsons website http://www.cpearson.com/excel/vbe.aspx - the part headed 'Ensuring The Editor In Synchronized'


shg - if you are interested in taking this threads challenge but are having trouble with the strThisModule line - you could change it to a constant and hardcode (yes I know but when nothing else works...) the name of the VBIDE module.

Small adjustment:

Private Sub CleanUpDeclarations()
'/ Puts variables at the start of a procedure (where they belong)
    Dim VBProj                As Object
    Dim VBComp                As Object
    Dim VBCodeMod             As Object
    Dim strProcName           As String
    Dim strThisModule         As String
    Dim strProcedure          As String
    Dim strModName            As String
    Dim ProcKind              As Long
    Dim lngModLineNo          As Long
    Dim lngStartLine          As Long
    Dim lngProcLine           As Long
    Dim lngNumLines           As Long

    'get name of this module - we dont want to check this
    strThisModule = Application.VBE.ActiveCodePane.CodeModule

    Set VBProj = ThisWorkbook.VBProject

    For Each VBComp In VBProj.VBComponents

        strModName = VBComp.Name

        If strModName <> strThisModule Then
            'Scan through the code module, looking for procedures
            With VBProj.VBComponents(strModName).CodeModule

                If .CountOfDeclarationLines > 0 Then
                    lngModLineNo = .CountOfDeclarationLines
                Else
                    lngModLineNo = 1
                End If

                Do While lngModLineNo < .CountOfLines

                    strProcName = .ProcOfLine(lngModLineNo, ProcKind)

                    If Len(strProcName) = 0 Then
                        lngModLineNo = lngModLineNo + 1
                    Else
                        lngStartLine = .ProcStartLine(strProcName, ProcKind)
                        lngProcLine = .ProcBodyLine(strProcName, ProcKind)
                        lngNumLines = .ProcCountLines(strProcName, ProcKind)
                        strProcedure = SortProc(.Lines(lngProcLine, lngNumLines))
                        .DeleteLines lngStartLine, lngNumLines
                        .InsertLines lngStartLine, strProcedure
                        lngModLineNo = lngModLineNo + .ProcCountLines(strProcName, ProcKind)
                    End If

                Loop

            End With

        End If
    Next VBComp

End Sub

Function SortProc(strProcedure As String) As String
    Dim vLines
    Dim n                     As Long
    Dim strLine               As String
    Dim strDec                As String
    Dim strOut                As String
    Dim bStarted              As Boolean

    vLines = Split(strProcedure, vbCrLf)

    For n = LBound(vLines) + 1 To UBound(vLines)
        strLine = Trim$(vLines(n))
        If Left$(LCase$(strLine), 4) = "dim " Then
            bStarted = True
            strDec = strDec & vbCrLf & vbTab & strLine
        Else
            If Not bStarted Then If Left$(strLine, 1) <> "'" _
                    And Left$(LCase$(strLine), 4) <> "rem " _
                    And LenB(strLine) <> 0 Then bStarted = True
                    
            If bStarted Then
                strOut = strOut & vbCrLf & vLines(n)
            Else
                strDec = strDec & vbCrLf & vLines(n)
            End If
        End If
    Next n
    SortProc = vLines(LBound(vLines)) & strDec & vbCrLf & strOut
End Function

I leave it to you to do the commented Dim lines and the Const...

Originally Posted by romperstomper

Small adjustment

Rory, if I could rep you twice I would! You solved the main challenge AND you beat the bonus challenge of having the Dims placed below any comments at the top of the procedure.

(Now we need this code added to the next version of MZ-Tools! )

Originally Posted by romperstomper

I leave it to you to do the commented Dim lines and the Const...

No worries. I hadn't included these in the challenge requirements.

I don't care about the commented Dim lines so much but I did intend for Consts to be placed at the top of the procedure with the Dims. My fault for overlooking mentioning this when I set the challenge! Now you've taken me this far, it took seconds to work out how to include the Consts. In SortProc I changed one line

If Left$(LCase$(strLine), 4) = "dim " Or Left$(LCase$(strLine), 6) = "const " Then

One last question - when I run your code on my test module, it removes the empty line between test and test2. How can I edit your code to stop it removing the gap between procedures?

I've tried

.InsertLines lngProcLine, strProcedure

and

.InsertLines lngStartLine + 1, strProcedure

- neither of these worked.

Originally Posted by mc84excel

when I run your code on my test module, it removes the empty line between test and test2. How can I edit your code to stop it removing the gap between procedures?

I've tried

.InsertLines lngProcLine, strProcedure

and

.InsertLines lngStartLine + 1, strProcedure

- neither of these worked.

Private Sub CleanUpDeclarations()
'/ Puts variables at the start of a procedure (where they belong)
'/ Rory Archibalds MVP

    Dim VBProj                As Object
    Dim VBComp                As Object
    Dim VBCodeMod             As Object
    Dim strProcName           As String
    Dim strThisModule         As String
    Dim strProcedure          As String
    Dim strModName            As String
    Dim ProcKind              As Long
    Dim lngModLineNo          As Long
    Dim lngStartLine          As Long
    Dim lngProcLine           As Long
    Dim lngNumLines           As Long

    'get name of this module - we dont want to check this
    strThisModule = Application.VBE.ActiveCodePane.CodeModule

    Set VBProj = ThisWorkbook.VBProject

    For Each VBComp In VBProj.VBComponents

        strModName = VBComp.Name

        If strModName <> strThisModule Then
            'Scan through the code module, looking for procedures
            With VBProj.VBComponents(strModName).CodeModule

                If .CountOfDeclarationLines > 0 Then
                    lngModLineNo = .CountOfDeclarationLines
                Else
                    lngModLineNo = 1
                End If

                Do While lngModLineNo < .CountOfLines

                    strProcName = .ProcOfLine(lngModLineNo, ProcKind)

                    If Len(strProcName) > 0 Then
                        lngStartLine = .ProcStartLine(strProcName, ProcKind)
                        lngProcLine = .ProcBodyLine(strProcName, ProcKind)
                        lngNumLines = .ProcCountLines(strProcName, ProcKind)
                        strProcedure = fnstrSortProc(.Lines(lngProcLine, lngNumLines))
                        .DeleteLines lngProcLine, (lngNumLines + lngStartLine - lngProcLine)
                        .InsertLines lngStartLine, strProcedure
                        lngModLineNo = lngModLineNo + .ProcCountLines(strProcName, ProcKind)
                    Else
                        lngModLineNo = lngModLineNo + 1
                    End If
                Loop
            End With
        End If
    Next VBComp
End Sub

Private Function fnstrSortProc(strProcedure As String) As String
    Dim astrLines()         As String
    Dim n                   As Long
    Dim strLine             As String
    Dim strDec              As String
    Dim strOut              As String
    Dim blnStarted          As Boolean

    astrLines = Split(strProcedure, vbCrLf)

    For n = LBound(astrLines) + 1 To UBound(astrLines)

        strLine = Trim$(astrLines(n))

        If Left$(LCase$(strLine), 4) = "dim " Or Left$(LCase$(strLine), 6) = "const " Then
            blnStarted = True
            strDec = strDec & vbCrLf & vbTab & strLine
        Else
            If Not blnStarted Then
                If Left$(strLine, 1) <> "'" _
                And Left$(LCase$(strLine), 4) <> "rem " _
                And LenB(strLine) <> 0 Then
                    blnStarted = True
                End If
            End If

            If blnStarted Then
                strOut = strOut & vbCrLf & astrLines(n)
            Else
                strDec = strDec & vbCrLf & astrLines(n)
            End If

        End If
    Next n

    fnstrSortProc = vbCrLf & astrLines(LBound(astrLines)) & strDec & vbCrLf & strOut
End Function

Originally Posted by mc84excel

[UPDATE - This challenge not beaten yet] P.S. For anyone looking for an even more advanced challenge - try converting to the Just In Time coding method. Any Dims in a procedure are moved to the line before the first instance they are used in that procedure.

The last (optional) challenge for this thread is still unsolved if anyone is interested