By Ama


2019-02-05 15:19:28 8 Comments

I recently developed a tool which automaticaly generates VBA code in order to smoothly create class templates. I wanted to share this tool with the community, hopefully this is the right place.

The idea is to put the definition of your class on "paper", via an excel spreadsheet:

  1. Create a new sheet or chose an empty spot on a random sheet
  2. Type the name of your class in one cell
  3. All the cells below will contain the name of a member of your class
  4. The cells adjacent (to the right) of the step 3 cells will provide the type (if the member is a method, leave blank)
  5. The cells adjacent to the step 4 cells will provide read and write attributes (if the member is a function or a method, leave blank)
  6. The cells adjacent to the step 5 cells will provide a description of the member (optional)
  7. The cells adjacent to the step 6 cells go by pairs and will provide the parameters of the member (for functions and methods only, and if relevant). There can be as many pairs as required: column N is the variable name, column N+1 is the variable type
  8. Select the range containing your data (except the Class name, which will be located just above your selection)
  9. Run subroutine Main (code provided below)
  10. The generated code is exported in the Inmediate Window

See below the example of an Excel sheet showing the class definition. The range selection required before running the code is shown in red.

enter image description here

The class template code generated from the above example looks as follows:

'CLIENTFILE
'
'Properties:
' - Id                       R   Long                     A cumulative Id number (attributed during initialization)
' - FirstName                RW  String                   First name
' - LastName                 RW  String                   Last Name
' - DateOfBirth              RW  Date                     Date of Birth
' - Sales                    RW  String Coll              A collection of strings which represent sales ID numbers
' - Proposals                RW  clsProposal coll         A collection of clsProposal objects which represent the proposals sent in the past

'Functions:
' - NewProposal                  clsProposal              Returns a Proposal for given sales parameters

'Methods:
' - SendBestWishes           Sends a wishes card (why not?)
' - MakePremium              Upgrades the client to Premium

Option Explicit


Private lId as Long
Private sFirstName as String
Private sLastName as String
Private dDateOfBirth as Date
Private cSales as New Collection
Private oProposals as New coll



'##### INITIALIZE #####

Private Sub class_Initialize()
    Debug.Print "clsClientFile initilized"
End Sub



'##### PROPERTIES #####


'# ID

'A cumulative Id number (attributed during initialization)
Public Property Get Id() as Long
    Id = lId
End Property


'# FIRSTNAME

'First name
Public Property Get FirstName() as String
    FirstName = sFirstName
End Property
Public Property Let FirstName(Var as String)
    sFirstName = Var
End Property


'# LASTNAME

'Last Name
Public Property Get LastName() as String
    LastName = sLastName
End Property
Public Property Let LastName(Var as String)
    sLastName = Var
End Property


'# DATEOFBIRTH

'Date of Birth
Public Property Get DateOfBirth() as Date
    DateOfBirth = dDateOfBirth
End Property
Public Property Let DateOfBirth(Var as Date)
    dDateOfBirth = Var
End Property


'# SALES

'A collection of strings which represent sales ID numbers
Public Property Get Sales() as Collection
    Set Sales = cSales
End Property
Public Property Set Sales(Var as Collection)
    Set cSales = Var
End Property


'# PROPOSALS

'A collection of clsProposal objects which represent the proposals sent in the past
Public Property Get Proposals() as coll
    Set Proposals = oProposals
End Property
Public Property Set Proposals(Var as coll)
    Set oProposals = Var
End Property



'##### FUNCTIONS #####


'# NEWPROPOSAL

'Returns a Proposal for given sales parameters
Public Function NewProposal(ByVal sTitle as String, ByVal sExpDate as Date) as clsProposal

End Function



'##### METHODS #####


'# SENDBESTWISHES

'Sends a wishes card (why not?)
Public Sub SendBestWishes(ByVal sAddress as String)

End Sub


'# MAKEPREMIUM

'Upgrades the client to Premium
Public Sub MakePremium

End Sub

The source code is provided below:


STANDARD MODULE

Option Explicit

'##### GEN CLASS CODE #####

'Generates code in the Immediate Window
'Select in a Spreadsheet the list of Properties, Functions, and Methods to be incorporated within the Class.
'The row just above the selection provides the Class Name in the cell of column 1 of the selection, and an optionnal Description in column 2.
'Each Row of the selection must represent a Member, and the Columns must be structured as follows: (x = must be provided, o = must not be provided, ? = can be provided)
'Column                            Property    Function    Method      Comment
' - 1:    Member Name                x           x           x
' - 2:    Member Variable Type       x           x           o         Variable Type of the Variable returned by Property or Function.
' - 3:    Member Rights              x           o           o         Defines if the Member is Read Only, Write Only, or Both: type 'R', 'W', or 'RW'.
' - 4:    Member Description         ?           ?           ?         Will be inserted in the Class Summary Header, as well as in the Member Mini Header. Usually empty if the Member is a Property.
' - 5-6+: Member Input Variables     o           ?           ?         Pairs of value : column N is VarName, column N+1 is VarType. If more than one Input Variable is required, reapeat with columns 7-8, etc.

'Non-Object Variable Types (Object variables require a Let and New statement)
Private Const cstNonObjectVariables = "Variant, Integer, Long, Single, Double, Currency, Date, String, Boolean, Byte, LongLong, LongPtr"

'Variable Type and their corresponding Prefix (for Hungarian style nomenclature; update cstVariablesPrefix to = "p, p, p, p, p, p, p, p, p, p, p, p, p, " to ignore)
Private Const cstVariableTypes = "Variant, Integer, Long, Single, Double, Currency, Date, String, Boolean, Byte, LongLong, LongPtr, Collection, Object"
Private Const cstVariablesPrefix = "v, i, l, sgl, dbl, ccy, d, s, b, by, h, h, c, o"

'Maximum lengths per column (for Class Summary Header)
Private Const cstMaxLenName = 25
Private Const cstMaxLenRW = 4
Private Const cstMaxLenVarType = 25

Sub main()

    '***** PREPARE DATA *****

    '# Read and Verify Selection

    Dim rngRawInput As Range
    Set rngRawInput = Selection

    If Selection.Columns.Count > 4 And (Selection.Columns.Count - 4) Mod 2 <> 0 _
    Then MsgBox "Selection is wrong, please try again", vbCritical + vbOKOnly, "Excel clsGen": End

    If rngRawInput.Columns.Count < 6 Then Set rngRawInput = rngRawInput.Resize(, 6)


    '# Save Selection Content

    Dim sClassName As String
    Dim sClassDescription As String

    sClassName = rngRawInput.Offset(-1, 0).Cells(1, 1).Value2
    sClassDescription = rngRawInput.Offset(-1, 0).Cells(1, 2).Value2


    Dim arrName() As Variant
    Dim arrVarType() As Variant
    Dim arrRights() As Variant
    Dim arrDescription() As Variant
    Dim arrInputVars() As Variant

    arrName = rngRawInput.Columns(1).Value2
    arrVarType = rngRawInput.Columns(2).Value2
    arrRights = rngRawInput.Columns(3).Value2
    arrDescription = rngRawInput.Columns(4).Value2
    arrInputVars = ActiveSheet.Range(Cells(rngRawInput.Row, rngRawInput.Column + 4), _
                                    Cells(rngRawInput.Row + rngRawInput.Rows.Count - 1, rngRawInput.Column + rngRawInput.Columns.Count - 1)).Value2


    '# Identify Selection Content Member Types and Populate relevant Collections

    Dim cProperties As New Collection
    Dim cFunctions As New Collection
    Dim cMethods As New Collection
    Dim myMember As clsGenClsMember

    Dim i As Integer
    Dim j As Integer
    For i = LBound(arrName) To UBound(arrName)

        Set myMember = New clsGenClsMember
        With myMember
            .Name = arrName(i, 1)
            .VarType = Replace(Split(arrVarType(i, 1) & " ", " ")(VBAexcelBasics.FunctionsStrings.strCount(CStr(arrVarType(i, 1)), " ")), "Coll", "Collection", , , vbTextCompare) '"oVariable Coll" -> "Collection" (of oVariable type)
            .VarTypeFull = arrVarType(i, 1)
            .Rights = arrRights(i, 1)
            .Description = arrDescription(i, 1)
            .InputVars = Application.WorksheetFunction.Index(arrInputVars, i, 0)

            'Input check
            If StrComp(.Name, "Val", vbTextCompare) = 0 Then _
            MsgBox "Member name cannot be 'val', please try again with another name.", vbCritical + vbOKOnly, "Excel clsGen": End

            If Len(.Name) > cstMaxLenName Or Len(.Rights) > cstMaxLenRW Or Len(.VarTypeFull) > cstMaxLenVarType Then _
            MsgBox "Member Name, RW statement, and/or Description are too long, please try again with something shorter.", vbCritical + vbOKOnly, "Excel clsGen": End

            'Member is a Property
            If .Name <> "" And .VarType <> "" And .Rights <> "" And .InputVars(1) = "" Then
                cProperties.Add myMember

            'Member is a Function
            ElseIf .Name <> "" And .VarType <> "" And .Rights = "" And .InputVars(1) <> "" Then
                cFunctions.Add myMember

            'Member is a Method
            ElseIf .Name <> "" And .VarType = "" And .Rights = "" Then
                cMethods.Add myMember

            'Unable to identify Member kind
            Else
                MsgBox "Unable to Identify Content of row " & i & " (" & .Name & "). Please verify and try again.", _
                    vbCritical + vbOKOnly, "Excel clsGen": End
            End If

        End With

    Next


    '***** PRINT DATA *****

    Dim sPrint As String
    Dim sOutput As String
    Dim arrNonObjectVariables() As String
    arrNonObjectVariables = Split(cstNonObjectVariables, ", ")

    '# Print Summary Header

    sPrint = "'@ClassName" & vbNewLine _
           & "'@ClassDescription" & vbNewLine _

    sPrint = Replace(sPrint, "@ClassName", StrConv(Mid(sClassName, 4, Len(sClassName) - 3), vbUpperCase))
    sPrint = Replace(sPrint, "@ClassDescription" & vbNewLine, IIf(sClassDescription = "", "", sClassDescription & vbNewLine))

    sOutput = sOutput & sPrint

    'Properties
    sOutput = sOutput & vbNewLine _
            & "'Properties:" & vbNewLine

    For Each myMember In cProperties
    With myMember
        sOutput = sOutput & "' - " & .Name & Space(cstMaxLenName - Len(.Name)) _
                                   & .Rights & Space(cstMaxLenRW - Len(.Rights)) _
                                   & .VarTypeFull & Space(cstMaxLenVarType - Len(.VarTypeFull)) _
                                   & .Description & vbNewLine
    End With
    Next

    'Functions
    sOutput = sOutput & vbNewLine _
            & "'Functions:" & vbNewLine

    For Each myMember In cFunctions
    With myMember
        sOutput = sOutput & "' - " & .Name & Space(cstMaxLenName + cstMaxLenRW - Len(.Name)) _
                                   & .VarTypeFull & Space(cstMaxLenVarType - Len(.VarTypeFull)) _
                                   & .Description & vbNewLine
    End With
    Next

    'Methods
    sOutput = sOutput & vbNewLine _
            & "'Methods:" & vbNewLine

    For Each myMember In cMethods
    With myMember
        sOutput = sOutput & "' - " & .Name & Space(cstMaxLenName - Len(.Name)) _
                                   & .Description & vbNewLine
    End With
    Next

    sOutput = sOutput & vbNewLine _
            & "Option Explicit" & vbNewLine _
            & vbNewLine _
            & vbNewLine


    '# Print Private Variables

    For Each myMember In cProperties
    With myMember

        sPrint = "Private @[email protected] as @New @VarType" & vbNewLine

        sPrint = Replace(sPrint, "@VarName", .Name)
        sPrint = Replace(sPrint, "@New ", IIf(UBound(Filter(arrNonObjectVariables, .VarType, , vbTextCompare)) > -1, "", "New "))
        sPrint = Replace(sPrint, "@p", VarPrefix(.VarType))
        sPrint = Replace(sPrint, "@VarType", .VarType)

        sOutput = sOutput & sPrint

    End With
    Next


    '# Print Initialize

    sPrint = vbNewLine _
           & vbNewLine _
           & vbNewLine _
           & "'##### INITIALIZE #####" & vbNewLine _
           & vbNewLine _
           & "Private Sub class_Initialize()" & vbNewLine _
           & "    Debug.Print ""@ClassName initilized"" " & vbNewLine _
           & "End Sub" & vbNewLine

    sPrint = Replace(sPrint, "@ClassName", sClassName)

    sOutput = sOutput & sPrint


    '# Print Properties

    sPrint = vbNewLine _
           & vbNewLine _
           & vbNewLine _
           & "'##### PROPERTIES #####" & vbNewLine

    sOutput = sOutput & sPrint

    For Each myMember In cProperties
    With myMember

        'Prepare Print
        sPrint = vbNewLine _
               & vbNewLine _
               & "'# @VARNAME" & vbNewLine _
               & vbNewLine

        If InStr(.Rights, "R") <> 0 Then sPrint = sPrint & "'@Description" & vbNewLine _
                                                         & "Public Property Get @VarName() as @VarType" & vbNewLine _
                                                         & "    @Set @VarName = @[email protected]" & vbNewLine _
                                                         & "End Property" & vbNewLine

        If InStr(.Rights, "W") <> 0 Then sPrint = sPrint & "Public Property @LetSet @VarName(Var as @VarType)" & vbNewLine _
                                                         & "    @Set @[email protected] = Var" & vbNewLine _
                                                         & "End Property" & vbNewLine

        'Replace PlaceHolders
        sPrint = Replace(sPrint, "@VARNAME", UCase(.Name))
        sPrint = Replace(sPrint, "@Description", .Description)
        sPrint = Replace(sPrint, "@VarName", .Name)
        sPrint = Replace(sPrint, "@VarType", .VarType)
        sPrint = Replace(sPrint, "@Set ", IIf(UBound(Filter(arrNonObjectVariables, .VarType, , vbTextCompare)) > -1, "", "Set "))
        sPrint = Replace(sPrint, "@p", VarPrefix(.VarType))
        sPrint = Replace(sPrint, "@LetSet", IIf(UBound(Filter(arrNonObjectVariables, .VarType, , vbTextCompare)) > -1, "Let", "Set"))

        sOutput = sOutput & sPrint

    End With
    Next


    '# Print Functions

    sPrint = vbNewLine _
           & vbNewLine _
           & vbNewLine _
           & "'##### FUNCTIONS #####" & vbNewLine

    sOutput = sOutput & sPrint

    Dim sArgumentPairs
    For Each myMember In cFunctions
    With myMember

        'Prepare Print
        sPrint = vbNewLine _
               & vbNewLine _
               & "'# @NAME" & vbNewLine _
               & vbNewLine _
               & "'@Description" & vbNewLine _
               & "Public Function @Name(@ArgumentPairs) as @VarType" & vbNewLine _
               & "    " & vbNewLine _
               & "End Function" & vbNewLine

        'Replace PlaceHolders
        sPrint = Replace(sPrint, "@NAME", UCase(.Name))
        sPrint = Replace(sPrint, "@Description", .Description)
        sPrint = Replace(sPrint, "@Name", .Name)
        sPrint = Replace(sPrint, "@VarType", .VarType)

        'Check if Arguments List provided
        If .InputVars(1) = "" Then
            sPrint = Replace(sPrint, "(@ArgumentPairs)", "")
        Else
            sArgumentPairs = ""
            For i = LBound(.InputVars) To UBound(.InputVars) Step 2
                If .InputVars(i) = "" Then Exit For
                sArgumentPairs = sArgumentPairs & "ByVal " & .InputVars(i) & " as " & .InputVars(i + 1) & ", "
            Next
            sArgumentPairs = Left(sArgumentPairs, Len(sArgumentPairs) - Len(", "))
            sPrint = Replace(sPrint, "@ArgumentPairs", sArgumentPairs)
        End If

        sOutput = sOutput & sPrint

    End With
    Next

    '# Print Methods

    sPrint = vbNewLine _
           & vbNewLine _
           & vbNewLine _
           & "'##### METHODS #####" & vbNewLine

    sOutput = sOutput & sPrint

    For Each myMember In cMethods
    With myMember

        'Prepare Print
        sPrint = vbNewLine _
               & vbNewLine _
               & "'# @NAME" & vbNewLine _
               & vbNewLine _
               & "'@Description" & vbNewLine _
               & "Public Sub @Name(@ArgumentPairs)" & vbNewLine _
               & "    " & vbNewLine _
               & "End Sub" & vbNewLine

        'Replace PlaceHolders
        sPrint = Replace(sPrint, "@NAME", UCase(.Name))
        sPrint = Replace(sPrint, "@Description", .Description)
        sPrint = Replace(sPrint, "@Name", .Name)

        'Check if Arguments List provided
        If .InputVars(1) = "" Then
            sPrint = Replace(sPrint, "(@ArgumentPairs)", "")
        Else
            sArgumentPairs = ""
            For i = LBound(.InputVars) To UBound(.InputVars) Step 2
                If .InputVars(i) = "" Then Exit For
                sArgumentPairs = sArgumentPairs & "ByVal " & .InputVars(i) & " as " & .InputVars(i + 1) & ", "
            Next
            sArgumentPairs = Left(sArgumentPairs, Len(sArgumentPairs) - Len(", "))
            sPrint = Replace(sPrint, "@ArgumentPairs", sArgumentPairs)
        End If

        sOutput = sOutput & sPrint

    End With
    Next


    '# Export Print Code to Immediate Window

    Debug.Print sOutput

End Sub


'# Returns the generic prefix of a given Variable Type, according to the Naming Convention
Private Function VarPrefix(sVarType As String) As String

    Dim arrVariableTypes() As String
    Dim arrVariablesPrefixes() As String
    arrVariableTypes = Split(cstVariableTypes, ", ")
    arrVariablesPrefixes = Split(cstVariablesPrefix, ", ")

    Dim i As Integer
    For i = LBound(arrVariableTypes) To UBound(arrVariableTypes)
        If StrComp(sVarType, arrVariableTypes(i), vbTextCompare) = 0 Then VarPrefix = arrVariablesPrefixes(i): Exit Function
    Next i

    'Else it is an Object
    VarPrefix = "o"

End Function

CLASS MODULE, Name = clsGenClsMember

Option Explicit

Private sName As String
Private sVarType As String
Private sVarTypeFull As String
Private sRights As String
Private sDescription As String
Private arrInputVars As Variant

Public Property Get Name() As String
    Name = sName
End Property
Public Property Let Name(Var As String)
    sName = Var
End Property

Public Property Get VarType() As String
    VarType = sVarType
End Property
Public Property Let VarType(Var As String)
    sVarType = Var
End Property

Public Property Get VarTypeFull() As String
    VarTypeFull = sVarTypeFull
End Property
Public Property Let VarTypeFull(Var As String)
    sVarTypeFull = Var
End Property

Public Property Get Rights() As String
    Rights = sRights
End Property
Public Property Let Rights(Var As String)
    sRights = Var
End Property

Public Property Get Description() As String
    Description = sDescription
End Property
Public Property Let Description(Var As String)
    sDescription = Var
End Property

Public Property Get InputVars() As Variant
    InputVars = arrInputVars
End Property
Public Property Let InputVars(Var As Variant)
    arrInputVars = Var
End Property

3 comments

@Mathieu Guindon 2019-02-06 16:40:02

This post is tagged with , but what I'm seeing is very ironically procedural code.

It doesn't matter that this is "just a quick tool": we're here to write professional, quality code that is easy to read and maintain, performs well, and correctly. Comintern has given great feedback and highlighted a number of bugs and edge cases - which is exactly the purpose of this site and the reason one puts their code up for peer review, as opposed to just sharing it on GitHub.

Procedural code is essentially a sequence of executable statements. This main procedure is exactly that. If this were actual object-oriented code, it might have read like this:

Public Sub Main()

    Dim info As ClassInfo
    Set info = GetClassInfo(Selection)
    If info Is Nothing Then
        MsgBox "Invalid Selection. Review debug output for details."
        Exit Sub
    End If

    CreateClassModule info

End Sub

10 lines, including vertical whitespace. With proper abstraction, no procedure ever really needs to be much longer than that, and we know at a glance exactly what the procedure does, at a high level; if we need to look into the gory details of how a ClassInfo object gets created, we need to drill down to the GetClassInfo function, which we know will return Nothing if something goes wrong; if we need to look into the gory details of how a class module gets created, we need to navigate to the CreateClassModule procedure, which we know will take a ClassInfo parameter.

CreateClassModule might look like this:

Private Sub CreateClassModule(ByVal info As ClassInfo)

    Dim path As String
    path = GetDestinationFilePath(info.Name)
    If path = vbNullString Then Exit Sub

    With FileWriter.Create(path)
        .Write info.ToString
    End With

End Sub

Again, the procedure fits a handful of lines, and it's trivially easy to understand what's going on. There's a GetDestinationFilePath function that probably prompts for a folder and returns a full path/filename (using the provided info.Name), or an empty string if that prompt is cancelled by the user. It then proceeds to create some FileWriter object that is responsible for the file I/O, and the file is trivially written by invoking its Write method, given info.ToString, which presumably builds a string representation of the class module. The FileWriter class has a VB_PredeclaredId attribute set to True and exposes a Create factory method (disclaimer: I wrote that article) that takes the path/filename of the file to be created; presumably the Class_Terminate handler ensures the file handle is properly closed, but that's a low-level implementation detail that CreateClassModule doesn't need to be bothered with and, as a matter of fact, isn't.

So we need a definition for this ClassInfo object; we know we're going to need a ToString method and a Name property. Anything else? I can think of a number of things:

'@Folder("Tools.ClassBuilder")
'@ModuleDescription("Describes the metadata needed for generating a class module.")
Option Explicit
Private Type TClassInfo
    Name As String
    Description As String
    IsPredeclared As Boolean
    IsExposed As Boolean
    Members As Collection
End Type

Private this As TClassInfo

Private Sub Class_Initialize()
    Set this.Members = New Collection
End Sub

'@Description("Gets/sets the name of the class. Must be a valid identifier. Determines the value of the 'VB_Name' attribute.")
Public Property Get Name() As String
    Name = this.Name
End Property

Public Property Let Name(ByVal value As String)
    'TODO: validate input!
    this.Name = value
End Property

'@Description("Gets/sets the description of the class. Determines the value of the 'VB_Description' attribute.")
Public Property Get Description() As String
    Description = this.Description
End Property

Public Property Let Descrition(ByVal value As String)
    'TODO: validate input!
    this.Description = value
End Property

'@Description("Gets/sets the value of the 'VB_PredeclaredId' attribute.")
Public Property Get IsPredeclared() As Boolean
    IsPredeclared = this.IsPredeclared
End Property

Public Property Let IsPredeclared(ByVal value As Boolean)
    this.IsPredeclared = value
End Property

'@Description("Gets/sets the value of the 'VB_Exposed' and, indirectly, the 'VB_Creatable' attribute.")
Public Property Get IsExposed() As Boolean
    IsExposed = this.IsExposed
End Property

Public Property Let IsExposed(ByVal value as Boolean)
    this.IsExposed = value
End Property

'@Description("Adds the specified member metadata to this instance.")
Public Sub AddMember(ByVal info As MemberInfo)
    'TODO: validate input!
    this.Members.Add info, info.Key
End Sub

'@Description("Builds a string representing the entire contents of the class module.")
Public Function ToString() As String
    With New StringBuilder
        .AppendLine BuildHeaderInfo
        Dim member As MemberInfo
        For Each member In this.Members
            .AppendLine member.ToString
        Next
        ToString = .ToString
    End With
End Function

Private Function BuildHeaderInfo() As String
    With New StringBuilder
        .AppendLine "VERSION 1.0 CLASS"
        .AppendLine "BEGIN"
        .AppendLine "  MultiUse = -1  'True"
        .AppendLine "END"
        .AppendLine "Attribute VB_Name = """ & this.Name & """"
        .AppendLine "Attribute VB_GlobalNameSpace = False" ' no effect in VBA
        .AppendLine "Attribute VB_Creatable = " & CStr(Not this.IsExposed)
        .AppendLine "Attribute VB_PredeclaredId = " CStr(this.IsPredeclared)
        .AppendLine "Attribute VB_Exposed = " CStr(this.IsExposed)
        .AppendLine "Attribute VB_Description = """ & this.Description & """"
        .AppendLine "'@ModuleDescription(""" & this.Description & """)"
        .AppendLine "Option Explicit"
        BuildHeaderInfo = .ToString
    End With
End Function

Note the explicit ByVal modifiers and the absolute absence of any kind of Hungarianesque prefixing scheme.

The '@Annotation comments are picked up by Rubberduck (full disclosure: I am one of the administrators of this open-source VBIDE add-in project); they serve the dual purpose of documenting attribute values, and (through Rubberduck features) of enforcing these attribute values. Again note that the largest procedure here is a trivial series of .AppendLine calls on some StringBuilder object that's responsible for efficiently building a string, and again these are private implementation details of the ToString method, which does nothing more than append this file header info and each module members' own string representation to the result.

So there needs to be a MemberInfo class - that's essentially the role your clsGenClsMember class is playing. But your class is just data - an object encapsulates data, yes, but an object also performs operations on this data: from the code above we know a MemberInfo at least needs a ToString method, i.e. a way to turn its data into a string representation, and a Key property that gets a string that combines the member kind (Sub, Function, PropertyGet, PropertyLet, PropertySet) with the member's name, so that the keyed collection doesn't choke when a PropertyLet member is added for, say, a Name property when a PropertyGet member already exists for it.

You get the idea by now: the GetClassInfo procedure invoked in Main creates a ClassInfo instance, then trivially iterates the rows in the source Range to create MemberInfo instances and add them to the class metadata; if a property needs a getter and a setter, then two MemberInfo instances are added.

This isn't any more complicated than writing procedural code. In fact, I would quite vehemently argue that it's simpler - and much easier to debug/maintain, extend/enhance, and test. Not because it's "just a quick tool". Writing object-oriented code isn't especially hard; it's about how we think about code, about how we model the problem to be solved. IMO this "quick little tool" could be a perfect excuse to learn to write modern, object-oriented VBA code.

@Mathieu Guindon 2019-02-06 16:51:27

Note: all code provided is air-code supplied for illustrative purposes; none of it was tested, and likely some adjustments are necessary (handling property members' backing fields comes to mind).

@Ama 2019-02-06 17:11:30

Never heard of the StringBuilder object before; great discovery today! On an other hand, I feel you guys should work on socializing with newcommers: Although usefull, these reviews are sadly full of unecessary and snobish wordings such as "ironically". The post is tagged as "Object Oriented" because the goal of the source code is to generate class modules.

@Mathieu Guindon 2019-02-06 17:15:40

@Ama I'll be honest, I was utterly thrilled yesterday when I saw your post. Then I saw how you kept defending the "but this is just a quick little tool for myself" standpoint, and I'll admit that did make me feel like reviewing it might not be worth the effort, since it wasn't clear whether you were even interested in improving this code in any way. Sorry this frustration transpired in my post and/or comments. As for OOP, as you can see there's much more to OOP than just using class modules.

@Ama 2019-02-06 17:27:53

I think I have been missinfored as to where I should have placed this code. Someone from Stack Overflow said that was the right place; whilst all I initially wanted was to share it with others, without expecting any comments on improving it (indeed I first was not really interested in improving this code). But I always take comments and have definitely learned a few things today. So I guess our paths will meet again, but for more 'serious' code, where I indeed encapsulate objects and use 10-20 lines long Subs. ;)

@Mathieu Guindon 2019-02-06 17:35:25

@Ama argh, SO folks always get CR wrong! ;-) CR is where you put up your best-looking, production-ready code up for review, and receive feedback on any/all aspects of it, in order to achieve the highest possible code quality. In the VBA tag you will encounter several maintainers of the Rubberduck OSS project, which I warmly encourage you to look into - reviewing the inspection results and code metrics can help pick up the low-hanging fruit before a CR reviewer gets their eyes on it. I hope to see you around here again!

@Ama 2019-02-06 17:40:26

Alright.. so that was like submitting a thesis.. ! :'D I already use Rubberduck, that's how I figured out my coding style was called "Hungarian"!

@Comintern 2019-02-06 17:49:43

@Ama - FWIW, you can disable the inspection in RD if you're attached to that notation style. It's not uncommon for CRs to spark spirited debates about style preferences or for different reviewers to post wildly different suggestions. It certainly helps to go into it with the understanding of what you're going to get though. I'm usually more disappointed if I don't get a handful of critical comments for a CR question - that's why I post them. ;-)

@Ama 2019-02-06 17:56:20

I did deactivate the Hungarian warning in RD haha. But that is about the only thing I deactivated. Under a .NET environnment I would agree on avoiding Hungarian style (plus how the hell would you manage all the prefixes, there are so many types, interfaces..). But for VBA I do find it usefull, if only to enhance intellisense, segregate Office objects from other objects, etc.

@Mathieu Guindon 2019-02-06 18:02:32

@Ama but you don't feel a need to segregate user classes from framework classes in .NET? Blending in is the whole point of conventions (i.e. PascalCase type & member names). I really don't want to drag this debate, but I see zero use in using HN in a statically typed language. Maybe if this were VBScript and everything had to be Variant, but in VBA/VB6 it just doesn't hold water IMO. As for IntelliSense, I guess I prefer typing "D" to get to "Description" ...so when RD starts hijacking IntelliSense and you can type "FSO" to get a "FileSystemObject", HN will die? ;-)

@Ama 2019-02-06 15:50:19

Updated source code, with the following comments from Comintern, and suggestion from Mathieu:

  1. Constants declarations now include types
  2. Additionnal warning regarding non-recognised variable types (enumerations, etc)
  3. One-Liners in the fashion of "If ABC Then Msgbox DEF: End" converted into several-liners
  4. The MyMember With-block has been optimized
  5. Missing type for sArgumentPairs has been added
  6. Var/Val inconsistency in data validation has been fixed

Also made the following updates:

  1. Simplified Class code (improved readability)
  2. Removed prefixing option as this was prone to generate debate over Hungarian style

STANDARD MODULE SOURCE CODE

Option Explicit

'##### GEN CLASS CODE FOR VBA #####

'Generates code in the Immediate Window
'Select in a Spreadsheet the list of Properties, Functions, and Methods to be incorporated within the Class.
'The row just above the selection provides the Class Name in the cell of column 1 of the selection, and an optionnal Description in column 2.
'Make sure your class Name begins with a 3-letters prefix (for example 'clsMyClassName').
'Each Row of the selection must represent a Member, and the Columns must be structured as follows: (x = must be provided, o = must not be provided, ? = can be provided)
'Column                            Property    Function    Method      Comment
' - 1:    Member Name                x           x           x
' - 2:    Member Variable Type       x           x           o         Variable Type of the Variable returned by Property or Function. Use "VarType Coll" to declare a Collection of 'VarType'.
' - 3:    Member Rights              x           o           o         Defines if the Member is Read Only, Write Only, or Both: type 'R', 'W', or 'RW'.
' - 4:    Member Description         ?           ?           ?         Will be inserted in the Class Summary Header, as well as in the Member Mini Header. Usually empty if the Member is a Property.
' - 5-6+: Member Input Variables     o           ?           ?         Pairs of value : column N is VarName, column N+1 is VarType. If more than one Input Variable is required, reapeat with columns 7-8, etc.

'Known non-Object Variable Types (Object variables require a Let and New statement)
'WARNING: Enumerations and user-defined Types are treated as Objects -> Changes to be made manually after Code Generation
Private Const cstNonObjectVariables As String = "Variant, Integer, Long, Single, Double, Currency, Date, String, Boolean, Byte, LongLong, LongPtr"

'Maximum lengths per column (for Class Summary Header)
Private Const cstMaxLenName As Long = 25
Private Const cstMaxLenRW As Long = 4
Private Const cstMaxLenVarType As Long = 25

Sub main()

    '***** PREPARE DATA *****

    '# Read and Verify Selection

    Dim rngRawInput As Range
    Set rngRawInput = Selection

    If Selection.Columns.Count > 4 And (Selection.Columns.Count - 4) Mod 2 <> 0 Then
        MsgBox "Selection is wrong, please try again", vbCritical + vbOKOnly, "Excel clsGen"
        End
    End If

    If rngRawInput.Columns.Count < 6 Then Set rngRawInput = rngRawInput.Resize(, 6)


    '# Save Selection Content

    Dim sClassName As String
    Dim sClassDescription As String

    sClassName = rngRawInput.Offset(-1, 0).Cells(1, 1).Value2
    sClassDescription = rngRawInput.Offset(-1, 0).Cells(1, 2).Value2


    Dim arrName() As Variant
    Dim arrVarType() As Variant
    Dim arrRights() As Variant
    Dim arrDescription() As Variant
    Dim arrInputVars() As Variant

    arrName = rngRawInput.Columns(1).Value2
    arrVarType = rngRawInput.Columns(2).Value2
    arrRights = rngRawInput.Columns(3).Value2
    arrDescription = rngRawInput.Columns(4).Value2
    arrInputVars = ActiveSheet.Range(Cells(rngRawInput.Row, rngRawInput.Column + 4), _
                                     Cells(rngRawInput.Row + rngRawInput.Rows.Count - 1, rngRawInput.Column + rngRawInput.Columns.Count - 1)).Value2


    '# Identify Selection Content Member Types and Populate relevant Collections

    Dim cProperties As New Collection
    Dim cFunctions As New Collection
    Dim cMethods As New Collection
    Dim myMember As clsGenClsMember

    Dim i As Integer
    Dim j As Integer
    For i = LBound(arrName) To UBound(arrName)

        With New clsGenClsMember
            .Name = arrName(i, 1)
            .VarType = Replace(Split(arrVarType(i, 1) & " ", " ")(VBAexcelBasics.FunctionsStrings.strCount(CStr(arrVarType(i, 1)), " ")), "Coll", "Collection", , , vbTextCompare) '"oVariable Coll" -> "Collection" (of oVariable type)
            .VarTypeFull = arrVarType(i, 1)
            .Rights = arrRights(i, 1)
            .Description = arrDescription(i, 1)
            .InputVars = Application.WorksheetFunction.Index(arrInputVars, i, 0)

            If StrComp(.Name, "Var", vbTextCompare) = 0 Then
                MsgBox "Member name cannot be 'Var', please try again with another name.", vbCritical + vbOKOnly, "Excel clsGen"
                End
            End If

            If Len(.Name) > cstMaxLenName Or Len(.Rights) > cstMaxLenRW Or Len(.VarTypeFull) > cstMaxLenVarType Then
                MsgBox "Member Name, RW statement, and/or Description are too long, please try again with something shorter.", vbCritical + vbOKOnly, "Excel clsGen"
                End
            End If

            'Member is a Property
            If .Name <> "" And .VarType <> "" And .Rights <> "" And .InputVars(1) = "" Then
                cProperties.Add .Self

            'Member is a Function
            ElseIf .Name <> "" And .VarType <> "" And .Rights = "" And .InputVars(1) <> "" Then
                cFunctions.Add .Self

            'Member is a Method
            ElseIf .Name <> "" And .VarType = "" And .Rights = "" Then
                cMethods.Add .Self

            'Unable to identify Member kind
            Else
                MsgBox "Unable to Identify Content of row " & i & " (" & .Name & "). Please verify and try again.", vbCritical + vbOKOnly, "Excel clsGen"
                End
            End If

        End With

    Next


    '***** PRINT DATA *****

    Dim sPrint As String
    Dim sOutput As String
    Dim arrNonObjectVariables() As String
    arrNonObjectVariables = Split(cstNonObjectVariables, ", ")


    '# Print Summary Header

    sPrint = "'@ClassName" & vbNewLine _
           & "'@ClassDescription" & vbNewLine _

    sPrint = Replace(sPrint, "@ClassName", StrConv(Mid(sClassName, 4, Len(sClassName) - 3), vbUpperCase))
    sPrint = Replace(sPrint, "@ClassDescription" & vbNewLine, IIf(sClassDescription = "", "", sClassDescription & vbNewLine))

    sOutput = sOutput & sPrint

    'Properties
    sOutput = sOutput & vbNewLine _
            & "'Properties:" & vbNewLine

    For Each myMember In cProperties
    With myMember
        sOutput = sOutput & "' - " & .Name & Space(cstMaxLenName - Len(.Name)) _
                                   & .Rights & Space(cstMaxLenRW - Len(.Rights)) _
                                   & .VarTypeFull & Space(cstMaxLenVarType - Len(.VarTypeFull)) _
                                   & .Description & vbNewLine
    End With
    Next

    'Functions
    sOutput = sOutput & vbNewLine _
            & "'Functions:" & vbNewLine

    For Each myMember In cFunctions
    With myMember
        sOutput = sOutput & "' - " & .Name & Space(cstMaxLenName + cstMaxLenRW - Len(.Name)) _
                                   & .VarTypeFull & Space(cstMaxLenVarType - Len(.VarTypeFull)) _
                                   & .Description & vbNewLine
    End With
    Next

    'Methods
    sOutput = sOutput & vbNewLine _
            & "'Methods:" & vbNewLine

    For Each myMember In cMethods
    With myMember
        sOutput = sOutput & "' - " & .Name & Space(cstMaxLenName - Len(.Name)) _
                                   & .Description & vbNewLine
    End With
    Next

    sOutput = sOutput & vbNewLine _
            & "Option Explicit" & vbNewLine _
            & vbNewLine _
            & vbNewLine


    '# Print Private Variables

    For Each myMember In cProperties
    With myMember

        sPrint = "Private [email protected] as @New @VarType" & vbNewLine

        sPrint = Replace(sPrint, "@VarName", .Name)
        sPrint = Replace(sPrint, "@New ", IIf(UBound(Filter(arrNonObjectVariables, .VarType, , vbTextCompare)) > -1, "", "New "))
        sPrint = Replace(sPrint, "@VarType", .VarType)

        sOutput = sOutput & sPrint

    End With
    Next


    '# Print Initialize

    sPrint = vbNewLine _
           & vbNewLine _
           & vbNewLine _
           & "'##### INITIALIZE #####" & vbNewLine _
           & vbNewLine _
           & "Private Sub class_Initialize()" & vbNewLine _
           & "    Debug.Print ""@ClassName initilized"" " & vbNewLine _
           & "End Sub" & vbNewLine

    sPrint = Replace(sPrint, "@ClassName", sClassName)

    sOutput = sOutput & sPrint


    '# Print Properties

    sPrint = vbNewLine _
           & vbNewLine _
           & vbNewLine _
           & "'##### PROPERTIES #####" & vbNewLine

    sOutput = sOutput & sPrint

    For Each myMember In cProperties
    With myMember

        'Prepare Print
        sPrint = vbNewLine _
               & vbNewLine _
               & "'# @VARNAME" & vbNewLine _
               & vbNewLine

        If InStr(.Rights, "R") <> 0 Then sPrint = sPrint & "'@Description" & vbNewLine _
                                                         & "Public Property Get @VarName() as @VarType" & vbNewLine _
                                                         & "    @Set @VarName = [email protected]" & vbNewLine _
                                                         & "End Property" & vbNewLine

        If InStr(.Rights, "W") <> 0 Then sPrint = sPrint & "Public Property @LetSet @VarName(Var as @VarType)" & vbNewLine _
                                                         & "    @Set [email protected] = Var" & vbNewLine _
                                                         & "End Property" & vbNewLine

        'Replace PlaceHolders
        sPrint = Replace(sPrint, "@VARNAME", UCase(.Name))
        sPrint = Replace(sPrint, "@Description", .Description)
        sPrint = Replace(sPrint, "@VarName", .Name)
        sPrint = Replace(sPrint, "@VarType", .VarType)
        sPrint = Replace(sPrint, "@Set ", IIf(UBound(Filter(arrNonObjectVariables, .VarType, , vbTextCompare)) > -1, "", "Set "))
        sPrint = Replace(sPrint, "@LetSet", IIf(UBound(Filter(arrNonObjectVariables, .VarType, , vbTextCompare)) > -1, "Let", "Set"))

        sOutput = sOutput & sPrint

    End With
    Next


    '# Print Functions

    sPrint = vbNewLine _
           & vbNewLine _
           & vbNewLine _
           & "'##### FUNCTIONS #####" & vbNewLine

    sOutput = sOutput & sPrint

    Dim sArgumentPairs as String
    For Each myMember In cFunctions
    With myMember

        'Prepare Print
        sPrint = vbNewLine _
               & vbNewLine _
               & "'# @NAME" & vbNewLine _
               & vbNewLine _
               & "'@Description" & vbNewLine _
               & "Public Function @Name(@ArgumentPairs) as @VarType" & vbNewLine _
               & "    " & vbNewLine _
               & "End Function" & vbNewLine

        'Replace PlaceHolders
        sPrint = Replace(sPrint, "@NAME", UCase(.Name))
        sPrint = Replace(sPrint, "@Description", .Description)
        sPrint = Replace(sPrint, "@Name", .Name)
        sPrint = Replace(sPrint, "@VarType", .VarType)

        'Check if Arguments List provided
        If .InputVars(1) = "" Then
            sPrint = Replace(sPrint, "(@ArgumentPairs)", "")
        Else
            sArgumentPairs = ""
            For i = LBound(.InputVars) To UBound(.InputVars) Step 2
                If .InputVars(i) = "" Then Exit For
                sArgumentPairs = sArgumentPairs & "ByVal " & .InputVars(i) & " as " & .InputVars(i + 1) & ", "
            Next
            sArgumentPairs = Left(sArgumentPairs, Len(sArgumentPairs) - Len(", "))
            sPrint = Replace(sPrint, "@ArgumentPairs", sArgumentPairs)
        End If

        sOutput = sOutput & sPrint

    End With
    Next

    '# Print Methods

    sPrint = vbNewLine _
           & vbNewLine _
           & vbNewLine _
           & "'##### METHODS #####" & vbNewLine

    sOutput = sOutput & sPrint

    For Each myMember In cMethods
    With myMember

        'Prepare Print
        sPrint = vbNewLine _
               & vbNewLine _
               & "'# @NAME" & vbNewLine _
               & vbNewLine _
               & "'@Description" & vbNewLine _
               & "Public Sub @Name(@ArgumentPairs)" & vbNewLine _
               & "    " & vbNewLine _
               & "End Sub" & vbNewLine

        'Replace PlaceHolders
        sPrint = Replace(sPrint, "@NAME", UCase(.Name))
        sPrint = Replace(sPrint, "@Description", .Description)
        sPrint = Replace(sPrint, "@Name", .Name)

        'Check if Arguments List provided
        If .InputVars(1) = "" Then
            sPrint = Replace(sPrint, "@ArgumentPairs", "")
        Else
            sArgumentPairs = ""
            For i = LBound(.InputVars) To UBound(.InputVars) Step 2
                If .InputVars(i) = "" Then Exit For
                sArgumentPairs = sArgumentPairs & "ByVal " & .InputVars(i) & " as " & .InputVars(i + 1) & ", "
            Next
            sArgumentPairs = Left(sArgumentPairs, Len(sArgumentPairs) - Len(", "))
            sPrint = Replace(sPrint, "@ArgumentPairs", sArgumentPairs)
        End If

        sOutput = sOutput & sPrint

    End With
    Next


    '# Export Print Code to Immediate Window

    Debug.Print sOutput

End Sub

CLASS MODULE SOURCE CODE (Name = clsGenClsMember)

'Stores the characteristics of one Member (one member per row within the user selected range)
Option Explicit

Public Name As String
Public VarType As String
Public VarTypeFull As String
Public Rights As String
Public Description As String
Public InputVars As Variant

'Allow self-reflection
Public Property Get Self() As clsGenClsMember
    Set Self = Me
End Property

The updated code generates the following code, using the following input:

enter image description here

'CLIENTFILE
'Description here

'Properties:
' - Id                       R   Long                     A cumulative Id number (attributed during initialization)
' - FirstName                RW  String                   First name
' - LastName                 RW  String                   Last Name
' - DateOfBirth              RW  Date                     Date of Birth
' - Sales                    RW  String Coll              A collection of strings which represent sales ID numbers
' - Proposals                RW  clsProposal Coll         A collection of clsProposal objects which represent the proposals sent in the past

'Functions:
' - NewProposal                  clsProposal              Returns a Proposal for given sales parameters

'Methods:
' - SendBestWishes           Sends a wishes card (why not?)
' - MakePremium              Upgrades the client to Premium

Option Explicit


Private pId as Long
Private pFirstName as String
Private pLastName as String
Private pDateOfBirth as Date
Private pSales as New Collection
Private pProposals as New Collection



'##### INITIALIZE #####

Private Sub class_Initialize()
    Debug.Print "clsClientFile initilized" 
End Sub



'##### PROPERTIES #####


'# ID

'A cumulative Id number (attributed during initialization)
Public Property Get Id() as Long
    Id = pId
End Property


'# FIRSTNAME

'First name
Public Property Get FirstName() as String
    FirstName = pFirstName
End Property
Public Property Let FirstName(Var as String)
    pFirstName = Var
End Property


'# LASTNAME

'Last Name
Public Property Get LastName() as String
    LastName = pLastName
End Property
Public Property Let LastName(Var as String)
    pLastName = Var
End Property


'# DATEOFBIRTH

'Date of Birth
Public Property Get DateOfBirth() as Date
    DateOfBirth = pDateOfBirth
End Property
Public Property Let DateOfBirth(Var as Date)
    pDateOfBirth = Var
End Property


'# SALES

'A collection of strings which represent sales ID numbers
Public Property Get Sales() as Collection
    Set Sales = pSales
End Property
Public Property Set Sales(Var as Collection)
    Set pSales = Var
End Property


'# PROPOSALS

'A collection of clsProposal objects which represent the proposals sent in the past
Public Property Get Proposals() as Collection
    Set Proposals = pProposals
End Property
Public Property Set Proposals(Var as Collection)
    Set pProposals = Var
End Property



'##### FUNCTIONS #####


'# NEWPROPOSAL

'Returns a Proposal for given sales parameters
Public Function NewProposal(ByVal Title as String, ByVal ExpDate as Date) as clsProposal

End Function



'##### METHODS #####


'# SENDBESTWISHES

'Sends a wishes card (why not?)
Public Sub SendBestWishes(ByVal Address as String)

End Sub


'# MAKEPREMIUM

'Upgrades the client to Premium
Public Sub MakePremium()

End Sub

@Comintern 2019-02-05 21:50:46

Before diving into the code itself, I'm going to go over a couple "structural things".

First, I'm not entirely sure what the utility of a tool like this actually is. When I'm writing code in the Visual Basic Editor, I get all of this great help like IntelliSense, syntax highlighting, an Object Browser, etc., etc. (and this is before using custom add-ins like Rubberduck1).

Writing code in a spreadsheet strikes me as, well, a bit strange. It seems like this wants a better interface - something like a wizard (or at very least a UserForm). Currently it has a major drawback in that it requires me to add a worksheet to an existing workbook to run it, which makes it harder to, say, package as an add-in.


The second glaring structural issue is that the code is output to the Immediate Window, which only has a 200 line buffer. The sample output from the question is already getting very close to running past that maximum buffer size (and this is exacerbated by some things I'll mention below). On top of that, there is absolutely zero validation to make sure that the output isn't going to end up with the top half of the template chopped off in the Immediate Window. This could be easily resolved by sending output to a text file or (better) using the VBE's object model to generate the class directly. I consider this a fairly substantial bug.


Coding Style


1.) Hungarian Notation2 - @MathieuGuindon provided an excellent link in his comment. I highly recommend reading it, and then using the current Microsoft Visual Basic Naming Conventions - they ditched this ancient style for a good reason.

That said, even if you completely disagree with this, the use of h as a prefix for LongPtr and LongLong is completely misleading to anyone familiar with the Windows APIs. In the Windows API, an h is a handle and lp is used for a long pointer. There's a difference between the two that simply can't be captured by a single variable type (and on a 32 bit install a Long could also be either a handle or a pointer). Consistently using h for any LongPtr is dangerously misleading. See this answer over on SO.


2.) Indentation - Overall not bad, but whatever convention you decide to use for indenting, it should be made consistent. For example, With is indented like this in some places...

For i = LBound(arrName) To UBound(arrName)

    Set myMember = New clsGenClsMember
    With myMember

... and this in others:

For Each myMember In cProperties
With myMember

I'd personally consider the top style "correct". Say what you will about other structures, but IMO a loop should always add another indentation level.


3.) Comments - Comments should explain the why of the code and not the how of the code. One perfect example of this is the comment '# Export Print Code to Immediate Window, followed immediately by Debug.Print sOutput. I'm going to go out on a limb here and say that if somebody is generating a class template from an Excel spreadsheet and doesn't know what Debug.Print does, they probably shouldn't be generating a class template from an Excel spreadsheet.

Code should be self documenting to the extend possible - this means picking names that make it obvious what things represent or do. Banner comments like '***** PREPARE DATA ***** inside of procedures are a huge red flag for me also. If the procedure needs a sign-post as to what's going on in a function, then that function is doing too much.

For example, in Sub main, I would at very least take each banner header like that and make it into a function of the same name, i.e. Function PrepareData(). The generated code probably doesn't need comments at all. First, because the comment at the top is basically just the data used to generate the class (and that's still on my spreadsheet, right?) - and if the object model is decent and the naming is good, I shouldn't need that at all.

Oh yeah - and that thing from earlier about the Immediate Window only having a 200 line buffer? This is where that bug is exacerbated. Every single needless comment reduces the amount of useful output that can be generated.


4.) The "God Procedure" - I alluded to this above, but the main procedure does way to much. The procedure body is 321 lines long, and requires paging down 7 times with my VBE settings to get from the top of the procedure to the bottom. If I strip out all of the vertical white-space and comments, it's still 208 lines (yep, 113 lines are pure scroll-bar). There's no conceivable way that I could tell with a casual inspection what it does (or what the variables are for that matter - they're mostly declared a couple hundred lines up). This should be split into discrete parts that each handle a very specific concern.


5.) Constants - First, these have types too - they should be explicitly declared. This...

Private Const cstMaxLenName = 25
Private Const cstMaxLenRW = 4
Private Const cstMaxLenVarType = 25

...should look more like this:

Private Const MaximumNameLength As Long = 25
Private Const MaximumAccessFlagLength As Long = 4
Private Const MaximumVariableTypeLength As Long = MaximumNameLength

In addition, cstVariableTypes and cstVariablesPrefix are only used by Function VarPrefix, and are only used once. I'd either move them inside the function...

Private Function VarPrefix(sVarType As String) As String

   Const VariableTypes As String = "Variant, Integer, Long, Single, Double, Currency, Date, String, Boolean, Byte, LongLong, LongPtr, Collection, Object"
   Const VariablePrefixes As String = "v, i, l, sgl, dbl, ccy, d, s, b, by, h, h, c, o"

...or simply inline the strings.


Miscellania

1.) This If block is complete torture:

If Selection.Columns.Count > 4 And (Selection.Columns.Count - 4) Mod 2 <> 0 _
Then MsgBox "Selection is wrong, please try again", vbCritical + vbOKOnly, "Excel clsGen": End

It combines a line continuation and an instruction separator to give a single line If statement that spans 2 lines and executes 2 statements. That's insanely difficult to read and is becoming is the source of numerous questions on SO. This is much, much, much better:

If Selection.Columns.Count > 4 And (Selection.Columns.Count - 4) Mod 2 <> 0 Then
    MsgBox "Selection is wrong, please try again", vbCritical + vbOKOnly, "Excel clsGen"
    Exit Sub
End If

Don't fight VBA's syntax - use it. The impetus to compact the code vertically won't be as great if the procedure isn't 321 lines long (see above).


2.) Related to the above, note also that End is not the same thing as Exit Sub. It forcibly terminates execution, meaning that it's up in the air as to whether rngRawInput's reference count gets decremented. This is most likely a memory leak and I'd consider it a bug. Note also that it took me longer to catch this than any other bug in this code because it's obscured by the "single-line" If statement (my eyes pick it out as End If) - see above.


3.) This section of code "leaks" an initialized object outside of the loop that it's used in:

For i = LBound(arrName) To UBound(arrName)
    Set myMember = New clsGenClsMember
    With myMember
      '...[Snip]...
    End With
Next

The variable myMember holds one reference, and the implicit With "placeholder" holds a second reference. If you merge the instantiation into the With, it ensures that the object gets released at the end of the block when it goes out of scope:

For i = LBound(arrName) To UBound(arrName)
    With New clsGenClsMember
        '...[Snip]...
    End With
Next

4.) VbMsgBoxStyle is a set of bit flags. That means they shouldn't be added like vbCritical + vbOKOnly. They should be combined with the Or operator: vbCritical Or vbOKOnly.


5.) There is almost zero validation for identifier names. What if I enter something into a cell with a newline in it? Or a variable name with a space? Or a name that begins with an underscore? Or a number? Or... etc. At a minimum, I would expect to see something like a regular expression to catch the most egregious of these.

Ironically, the only thing that is validated is that "Member name cannot be 'val'" . When I originally saw that, I thought to myself - "Oh, that's because Val is a built in VBA function.". But there's no other name collision testing (although there probably should be). It strikes me more like this used to be the default parameter name in the generated class instead of Var, but it was later renamed because Val was hiding stuff...


6.) Speaking of validation, the member names are being validated in the wrong place. They're checked here (and have the plug forcibly pulled if they're too long - see the discussion of End above)...

If Len(.Name) > cstMaxLenName Or Len(.Rights) > cstMaxLenRW Or Len(.VarTypeFull) > cstMaxLenVarType Then _
MsgBox "Member Name, RW statement, and/or Description are too long, please try again with something shorter.", vbCritical + vbOKOnly, "Excel clsGen": End

...but when they're used, they're coming from clsGenClsMember unchecked:

With myMember
    sOutput = sOutput & "' - " & .Name & Space(cstMaxLenName - Len(.Name)) _
                               & .Rights & Space(cstMaxLenRW - Len(.Rights)) _
                               & .VarTypeFull & Space(cstMaxLenVarType - Len(.VarTypeFull)) _
                               & .Description & vbNewLine
End With

This is a clear violation of separation of responsibilities, and I can't be the only one who sees irony in code that generates classes doing this. If the maximum Name length for a clsGenClsMember is 25, the class should be enforcing it, not the caller.

Note that this allows unchecked code like .Name & Space(cstMaxLenName - Len(.Name)) which throws if the class doesn't enforce this. This is borderline buggy.


7.) All of the code with place-holders and Replace needs validation:

   sPrint = "Private @[email protected] as @New @VarType" & vbNewLine
   sPrint = Replace(sPrint, "@VarName", .Name)

What happens if I use a place-holder in the input? It would probably be better to concatenate these instead.


8.) The list of intrinsic variables doesn't take types and enumerations into account. That means when it checks to see if a property should be generated as a Let or a Set in code like this...

sPrint = Replace(sPrint, "@New ", IIf(UBound(Filter(arrNonObjectVariables, .VarType, , vbTextCompare)) > -1, "", "New "))

...it is ignoring things like VbMsgBoxStyle from above. There's not really a way to definitively know which one to use in all cases, because you can use Set with a Variant too. Barring going off to read the type libraries and figuring it out, this is likely best left to user input - I'd also consider this a bug.

Note also that this should be a responsibility of clsGenClsMember, not the calling code.


9.) There is at least one declaration missing variable types:

Dim sArgumentPairs

Hungarian says that's a String, but it lies - that's a Variant (this highlights part of the problem with Hungarian notation...see above).


10.) Similar to #8, this default prefix in VarPrefix...

'Else it is an Object
VarPrefix = "o"

...is broken for the same way. E.g. Dim oNoImNotAnObject As MyType...


There probably more ground to cover (I didn't even get to running code analysis on this), but I'll leave that to other reviewers as this is already running a tad long...


1 Full disclosure, I'm a contributor to that project.

2 Fuller disclosure, I implemented the Hungarian notation inspection in Rubberduck too.

@rolfl 2019-02-06 18:35:22

Comments are not for extended discussion; this conversation has been moved to chat.

Related Questions

Sponsored Content

1 Answered Questions

[SOLVED] VBA Copy and Delete Rows loop optimisation

  • 2019-04-25 15:24:48
  • Matt Williams
  • 54 View
  • 1 Score
  • 1 Answer
  • Tags:   vba excel

0 Answered Questions

Copy and Transpose Macro VBA

  • 2019-04-06 16:52:54
  • Lonnie
  • 68 View
  • 1 Score
  • 0 Answer
  • Tags:   vba excel

0 Answered Questions

Free body diagram generator using MVP for VBA

1 Answered Questions

[SOLVED] Error-Handling Class and Logging for VBA

3 Answered Questions

[SOLVED] Perf wrapper for Excel VBA

1 Answered Questions

[SOLVED] VBA Class to persist and restore Excel Application properties

1 Answered Questions

[SOLVED] VBA code for testing efficency

1 Answered Questions

[SOLVED] Inserting and Populating Chart with Excel VBA

  • 2016-01-15 09:18:41
  • Jean-Pierre Oosthuizen
  • 485 View
  • 3 Score
  • 1 Answer
  • Tags:   vba excel

3 Answered Questions

Sponsored Content