Problems using a ClassFactory for Custom Objects-CodePudding

I'm trying to use a classfactory function for creating, initializing, and defining parameters of a custom object. I'm hitting the "Object variable or With block variable not set" error which I've read means I'm probably using or not using Set keyword correctly, but I've tried every variation I can think of on the relevant lines of code and it looks like the error is within the class module which I've learned is difficult to debug within...

Here's my module code:

Sub CreateLineItemObject()
    Dim oLI As LineItem
    Dim rowNum As Integer
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    rowNum = Application.Selection.Row
    Set oLI = oLI.ClassFactory(rowNum)
End Sub

And my "LineItem" Class Module:

Option Explicit

Private ws As Worksheet
Private mLInum As Integer
Private mRowNum As String
Private mCostCode As String
Private mDescription1 As String
Private mDescription2 As String
Private mNote1 As String
Private mNote2 As String
Private mDebugInfo As String

Public Function ClassFactory(ByVal rowNum As Integer) As LineItem
    ws = ThisWorkbook.Worksheets("Sheet1")
    Dim liType As String
    Dim oLI As LineItem
    Set oLI = New LineItem
    liType = ws.Cells(rowNum, 2).Value
   
    Select Case liType
        Case "Budget"
            oLI.Init rowNum
            Set ClassFactory = oLI
        Case "Actual"
            MsgBox "Actual Line Item found, use this on Actual Line Item"
        Case Else
            MsgBox "Unknown Error"
        
    End Select
    
End Function

Sub Init(rowNum As Integer)
    ws = ThisWorkbook.Worksheets("Sheet1")
    mRowNum = rowNum
    mLInum = ws.Cells(rowNum, 1).Value
    mCostCode = ws.Cells(rowNum, 3).Value
    mDescription1 = ws.Cells(rowNum, 5).Value
    mDescription2 = ws.Cells(rowNum   1, 5).Value
    mNote1 = ws.Cells(rowNum, 6).Value
    mNote2 = ws.Cells(rowNum   1, 6).Value
    mDebugInfo = "string outputting member vars"
    MsgBox mDebugInfo
End Sub

EDIT: Also, I'm unclear as to if the line:

    Set oLI = oLI.ClassFactory(rowNum)

in the module code should include the second 'oLI.' or not since the example I followed online omitted it, but I run into errors when I don't have that included.

CodePudding user response：

Here are my suggestions:

You might do better to avoid using specific worksheet names at a low level in the code. Instead set a variable to a reference to the worksheet at the top (event) level (such as button_click()), and pass that reference down to lower-level functions. This means that you need not derive a reference the worksheet name or relative worksheet number at a lower level and makes it easier if you change the names of worksheets later.
Rather than getting hold of the row number from a range and passing that number as a parameter to a function, give the function the reference to the range. Then it does not need to reconstruct the reference to a worksheet range from the row number.
When referencing fixed worksheets, it is better if possible to refer directly to the underlying name of the worksheet, rather than its display name, which could be changed by a user. By default the sheet names are Sheet1, Sheet2 etc, but you can give them meaningful names by setting the property (Name) in the properties sheet.
Depending on how you plan to use your vba objects, instead of loading property values from the worksheet into members of the object, you may find it useful to keep a reference to the worksheet range, and have Public Property Get propertyName() properties of the object, which get their values direct from the cells of the sheet to which the object refers. This would allow for the situation that a value changes in the sheet after the object has been created - but maybe in your app that cannot happen. Another advantage of this approach is that the object remains valid even if someone (or some script) inserts rows above the referenced cells - the object keeps its reference to the same cells even if they are moved up and down.
I suggest putting all your factory functions a separate Factory module, then having public function newClassName() for each of your classes. In this module keep a count of every object instantiated and assign that unique number to every instance. This is useful for debugging - include the instance number in a debug report function.
I think you might find it useful to have the factory always return an instance of the object and have a property of the object to indicate if it has been loaded successfully. This would be useful, say, if you want to defer reporting errors that have been found.

I have been modifying your code to illustrate some of these points and below is the result. The usage may not correspond at all to the way you plan to use your object, but the techniques used may give you some ideas.

Code module Factory

    Option Explicit
    
    '// Array of line items indexed by row number to make
    '// them easy to find from a Sheet.SelectionChange event
    Private allLineItems() As LineItem
    
    
    '// Line Item factory function takes a reference
    '// to the worksheet row (not a row number)
    '// This is passed to the new object
    Public Function newLineItem(rRow As Range) As LineItem
        
        '// create the new object
        Set newLineItem = New LineItem
    
        '// Save the item in the index by row number
        Dim nRow As Long: nRow = rRow.Row
        If (Not allLineItems) = -1 Then
            ReDim allLineItems(nRow   1000)
        ElseIf UBound(allLineItems) < nRow Then
            ReDim Preserve allLineItems(nRow   1000)
        End If
        Set allLineItems(nRow) = newLineItem
        
    
        '// Link the object to the worksheet row and check if successful
        If newLineItem.linkToRow(rRow) Then
            Debug.Print "Successful load from row " & nRow & " created object instance " & newLineItem.ID
            newLineItem.selectObjectOnSheet
        End If
    
    
    End Function
    
    '// Utility function for assigning object IDs as a serial number
    Public Function nextIndex() As Long
        Static ixNum As Long
        ixNum = ixNum   1
        nextIndex = ixNum
    End Function
    

    '// Function used to find and highlight a line item
    '// on a specific row of the sheet, if any
    Public Function findLineItem(atRow As Range) As LineItem
    
        '// Find the item corresponding to the given row
        Dim nRow As Long: nRow = atRow.Row

        '// Check array size first
        If (Not allLineItems) = -1 Then Exit Function
        If UBound(allLineItems) < nRow Then Exit Function


        '// The last item that was highlit, if any
        Static oHilitItem As LineItem
    
        
    
        '// Find the item corresponding to the given row
        Dim oInstance As LineItem: Set oInstance = allLineItems(nRow)
        If oInstance Is Nothing Then Set oInstance = allLineItems(nRow - 1)
        
        Set findLineItem = oInstance
    
        '// Clear the highlight on the last one highlit, if any
        If Not oHilitItem Is Nothing Then
            If Not oInstance Is Nothing Then If oInstance.ID = oHilitItem.ID Then Exit Function
            oHilitItem.clearHighlight
            Set oHilitItem = Nothing
        End If
    
        '// If a LineItem was found, then highlight the range for this item
        If Not oInstance Is Nothing Then
            oInstance.highlight
            oInstance.reportToDebug
            Set oHilitItem = oInstance
        End If
        
    End Function

Class module LineItem

    Option Explicit
    
    '// Object instance unique number
    Private mUID As Long
    
    '// Reference to worksheet range
    Private mMyRange As Range
    
    '// Valid flag
    Private mIsValid As Boolean
    
    '// Debug info
    Private mDebugInfo As String
    
    '// ----------------------------------- Properties for accessing object data
    
    '// Most properties are accessed direct from the worksheet range that the object is linked to
    
    Public Property Get ID() As Long
        ID = mUID
    End Property
    
    Public Property Get worksheetName() As String
        worksheetName = mMyRange.Worksheet.Name
    End Property
    
    Public Property Get rowNum() As Long
        rowNum = mMyRange.Row
    End Property
    
    Public Property Get liType() As String
        liType = "" & mMyRange.Cells(1, 2).Value
    End Property
    
    Public Property Get liNum() As Long
        liNum = mMyRange.Cells(1, 1)
    End Property
    
    Public Property Get costCode() As String
        costCode = mMyRange.Cells(1, 3)
    End Property
    
    '// Description Line is indexed by line number
    Public Property Get descriptionLine(iLine As Integer) As String
        descriptionLine = "" & mMyRange.Cells(iLine, 5).Value
    End Property
    
    '// Note line is indexed by line number
    Public Property Get noteLine(iLine As Integer) As String
        noteLine = "" & mMyRange.Cells(iLine, 6).Value
    End Property
    
    '// Debug info used to store error information
    Public Property Get debugInfo() As String
        debugInfo = mDebugInfo
    End Property
    
    '// Valid flag set to true if successfully loaded
    Public Property Get isValid()
        isValid = mIsValid
    End Property
    
    
    '// System functions for initialise and terminate
    Private Sub Class_Initialize()
        mUID = Factory.nextIndex
        log "Creating new LineItem #" & mUID
    End Sub
    
    Private Sub Class_Terminate()
        clearHighlight
        log "Terminating LineItem #" & mUID
    
    End Sub
    
    
    '// This is the initialisation function that links the object to the
    '// specific area of the sheet containing the object data
    Public Function linkToRow(rRangeToBeLinked As Range) As Boolean
        mDebugInfo = ""
        mIsValid = False
        
        '// Set the range to be linked to cols A to F, in two rows starting from the given reference
        '// This ensures that even if the reference passed is not to column A, or is for an odd shaped
        '// area, the derived reference is to the exact shape and location where the item data should be
        Dim rowNum As Long: rowNum = rRangeToBeLinked.Row
        Set mMyRange = rRangeToBeLinked.Worksheet.Range("A" & rowNum & ":F" & (rowNum   1))
        
        '// Check the line type
        Select Case Me.liType
            Case "Actual"
                mDebugInfo = "ERROR IN LOADING: Budget expected but Actual found on row " & mMyRange.Row
                log mDebugInfo
    
            Case "Budget"
                mIsValid = True
    
            Case Else
            
                mDebugInfo = "ERROR IN LOADING: Line type [" & Me.liType & "] not recognised on row " & mMyRange.Row
        End Select
    
        '// Return true if successfully loaded
        linkToRow = mIsValid
    
        '// Set the style on the linked range to indicate if successful to the user
        mMyRange.Style = IIf(mIsValid, "Good", "Bad")
    
    End Function
    
    '// Selects the line item area on the worksheet. Can be called
    '// from an event (e.g. from a listbox click) to move the user's focus to the specific
    '// item on the worksheet.
    Public Sub selectObjectOnSheet()
        mMyRange.Worksheet.Parent.Activate
        mMyRange.Worksheet.Activate
        mMyRange.Select
    End Sub
    
    '// Highlights the item by setting the style on the item range in the worksheet
    Public Sub highlight()
        If Me.isValid Then
            mMyRange.Style = "20% - Accent6"
        Else
            mMyRange.Style = "Bad"
        End If
        log "Line item #" & mUID & " highlighted"
    End Sub
    
    '// Clears the style from the item range on the worksheet
    Public Sub clearHighlight()
        mMyRange.Style = "Normal"
    End Sub
    
    '====================================================================================
    '// Reports the complete object to the debug
    Public Sub reportToDebug()
        log "Line Item Report ------------ Instance #" & mUID
    
        log "Sheet", Me.worksheetName
        log "Row", Me.rowNum
        log "Line type", Me.liType
        log "Is valid?", Me.isValid
    
        log "CostCode", Me.costCode
        log "Description", Me.descriptionLine(1)
        log "", Me.descriptionLine(2)
        log "Note", Me.noteLine(1)
        log "", Me.noteLine(2)
    End Sub

code module util

Option Explicit


Public Sub log(text As String, Optional varValue As Variant = "!$%^&*")
    If IIf(VarType(varValue) = vbString, varValue, "") = "!$%^&*" Then
        Debug.Print text
    Else
        Debug.Print Left(text & "                    ", 15) & ": " & varValue
    End If
End Sub

code module test

Option Explicit

Sub test()

    Dim li1 As LineItem

    '// Item on row 5
    Set li1 = Factory.newLineItem(Sheet1.Range("A5"))
    li1.selectObjectOnSheet
    If Not li1.isValid Then li1.reportToDebug: MsgBox li1.debugInfo

    '// Item on row 8
    Dim li2 As LineItem
    Set li2 = Factory.newLineItem(Sheet1.Range("A8"))
    li2.selectObjectOnSheet
    If Not li2.isValid Then li2.reportToDebug: MsgBox li2.debugInfo

    '// Item on row 11
    Dim li3 As LineItem
    Set li3 = Factory.newLineItem(Sheet1.Range("M11"))
    li3.selectObjectOnSheet
    If Not li3.isValid Then li3.reportToDebug: MsgBox li3.debugInfo

    '// Item on row 14
    Dim li4 As LineItem
    Set li4 = Factory.newLineItem(Sheet1.Range("A14"))
    li4.selectObjectOnSheet
    If Not li4.isValid Then li4.reportToDebug: MsgBox li4.debugInfo

    MsgBox "Line items created - now move around sheet"

End Sub

Data in Sheet1

Woksheet module for Sheet1

Option Explicit


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
    log "Moving to row " & Target.Row

    Factory.findLineItem(Target)
    
End Sub

CodePudding user response：

It looks like I made several mistakes:

ClassFactory method belongs in Module code, not Class module code (biggest one)
Add 'Set' to line ws = ThisWorkbook.Worksheets("Sheet1")
Using ' ' for text concat instead of '&' for debug string (not included in the sample code above to simplify before posting, but turned out this was likely source of error)
Using .Value on an integer to build the debug string (not included in the sample code above to simplify before posting, but turned out this was likely source of error)

Thanks for all the comments and suggestions!