CODEWITHSUNDEEP
vbaobjectcollectionspropertiesobject-properties
joeb
joeb

Reputation: 877

Excel VBA: Adding Collection to class property

I'm working on a little project and I keep getting a problem with one of the "letters" where it's saying Arguement not optional.

I have clsXML which is here

The line i am getting the error on is here CurrentProduct.Prompts = PromptsCollection

Private Function GetProductsCollection() As Collection
Dim AWP As New clsAWP
Dim PurchaseOrderProductCollection As New Collection
Dim ProductsTopRange As Range
Dim ProductsBottomRange As Range
Dim Row As Range
Dim Product As New clsProduct
Dim PurchaseOrderRange As Range

Set ProductsTopRange = Sheets("Purchase Order").Range("ProductTableTop")
Set ProductsBottomRange = Sheets("Purchase Order").Range("ProductTableBottom")

'Add all Top Range Products
For Each Row In ProductsTopRange.Rows
    If Not IsEmpty(Row.Cells(1, 1).Value) Then
        Dim CurrentSKU As New clsSKU
        Set CurrentSKU = Product.GetSKU(Row.Cells(1, 1).Value)
        If Not IsEmpty(CurrentSKU) And CurrentSKU.Category = "Product" Then
            Dim CurrentProduct As New clsProduct
            CurrentProduct.SKU = Row.Cells(1, 1).Value
            CurrentProduct.Width = Row.Cells(1, 2).Value
            CurrentProduct.Height = Row.Cells(1, 3).Value
            CurrentProduct.Depth = Row.Cells(1, 4).Value
            CurrentProduct.Skins = Row.Cells(1, 10).Value
            CurrentProduct.Swing = Row.Cells(1, 13).Value
            CurrentProduct.Qty = Row.Cells(1, 14).Value

            Dim PromptsCollection As New Collection
            'add all prompts to collection
            Dim ToeKickHeight As New clsPrompt
            ToeKickHeight.Name = "Toe_Kick_Height"
            ToeKickHeight.Value = Row.Cells(1, 18).Value
            PromptsCollection.Add ToeKickHeight

            Dim AdjShelfQty As New clsPrompt
            AdjShelfQty.Name = "Adj_Shelf_Qty"
            AdjShelfQty.Value = Row.Cells(1, 19).Value
            PromptsCollection.Add AdjShelfQty

            Dim LSW As New clsPrompt
            LSW.Name = "Left_Stile_Width"
            LSW.Value = Row.Cells(1, 20).Value
            PromptsCollection.Add LSW

            Dim RSW As New clsPrompt
            RSW.Name = "Right_Stile_Width"
            RSW.Value = Row.Cells(1, 21).Value
            PromptsCollection.Add RSW

            Dim TRW As New clsPrompt
            TRW.Name = "Top_Rail_Width"
            TRW.Value = Row.Cells(1, 22).Value
            PromptsCollection.Add TRW

            Dim BRW As New clsPrompt
            BRW.Name = "Bottom_Rail_Width"
            BRW.Value = Row.Cells(1, 23).Value
            PromptsCollection.Add BRW

            Dim ELSFFD As New clsPrompt
            ELSFFD.Name = "Extend_Left_Side_FF_Down"
            ELSFFD.Value = Row.Cells(1, 24).Value
            PromptsCollection.Add ELSFFD

            Dim ELSFFU As New clsPrompt
            ELSFFU.Name = "Extend_Left_Side_FF_Up"
            ELSFFU.Value = Row.Cells(1, 25).Value
            PromptsCollection.Add ELSFFU

            Dim ERSFFD As New clsPrompt
            ERSFFD.Name = "Extend_Right_Side_FF_Down"
            ERSFFD.Value = Row.Cells(1, 26).Value
            PromptsCollection.Add ERSFFD

            Dim ERSFFU As New clsPrompt
            ERSFFU.Name = "Extend_Right_Side_FF_Up"
            ERSFFU.Value = Row.Cells(1, 27).Value
            PromptsCollection.Add ERSFFU

            Dim ETR As New clsPrompt
            ETR.Name = "Extend_Top_Rail"
            ETR.Value = Row.Cells(1, 28).Value
            PromptsCollection.Add ETR

            Dim EBR As New clsPrompt
            EBR.Name = "Extend_Bottom_Rail"
            EBR.Value = Row.Cells(1, 29).Value
            PromptsCollection.Add EBR

MsgBox (PromptsCollection.Count)
            CurrentProduct.Prompts = PromptsCollection
            CurrentProduct.MVProductName = CurrentSKU.MVProductName

            PurchaseOrderProductCollection.Add CurrentProduct
        End If
    Else
        'skip the row
    End If
Next

and here is taking a look inside the product class, I've removed all the other getters and letters for clarity.

 Option Explicit

 Private pSKU As String
 Private pWidth As String
 Private pHeight As String
 Private pDepth As String
 Private pSkins As String
 Private pSwing As String
 Private pQty As String
 Private pToeKickHeight As String
 Private pAdjShelfQty As String
 Private pLeftStileWidth As String
 Private pRightStileWidth As String
 Private pTopRailWidth As String
 Private pBottomRailWidth As String
 Private pExtLSFFD As String
 Private pExtLSFFU As String
 Private pExtRSFFD As String
 Private pExtRSFFU As String
 Private pExtTopRail As String
 Private pExtBottomRail As String
 Private pMVProductName As String
 Private pPrompts As Collection

Public Property Get Prompts() As Collection
Prompts = pPrompts
End Property

Public Property Let Prompts(Val As Collection)
pPrompts = Val
End Property

Public Function GetSKU(ByVal SKU As String) As Object

Dim DataTable As Range
Dim ProductSKURange As Range
Dim Product As New clsSKU
Dim SheetName As String

SheetName = "Purchase Order"
Set DataTable = Range("DataTable")
Set ProductSKURange = DataTable.Find(SKU, LookIn:=xlValues)
If Not ProductSKURange Is Nothing Then
    Product.SKU = Sheets(SheetName).Range("AE" & ProductSKURange.Row).Value
    Product.A = CDbl(Sheets(SheetName).Range("AF" & ProductSKURange.Row).Value)
    Product.B = CDbl(Sheets(SheetName).Range("AG" & ProductSKURange.Row).Value)
    Product.C = CDbl(Sheets(SheetName).Range("AH" & ProductSKURange.Row).Value)
    Product.D = CDbl(Sheets(SheetName).Range("AI" & ProductSKURange.Row).Value)
    Product.E = CDbl(Sheets(SheetName).Range("AJ" & ProductSKURange.Row).Value)
    Product.F = CDbl(Sheets(SheetName).Range("AK" & ProductSKURange.Row).Value)
    Product.G = CDbl(Sheets(SheetName).Range("AL" & ProductSKURange.Row).Value)
    Product.Description = Sheets(SheetName).Range("AM" & ProductSKURange.Row).Value
    Product.MVProductName = Sheets(SheetName).Range("AN" & ProductSKURange.Row).Value
    Product.Width = Sheets(SheetName).Range("AO" & ProductSKURange.Row).Value
    Product.Height = Sheets(SheetName).Range("AP" & ProductSKURange.Row).Value
    Product.Depth = Sheets(SheetName).Range("AQ" & ProductSKURange.Row).Value
    Product.Category = Sheets(SheetName).Range("AR" & ProductSKURange.Row).Value
End If

Set GetSKU = Product
End Function

Please let me know where I am going wrong. Thanks in advance.

Upvotes: 1

Views: 714

Answers (1)

R3uK
R3uK

Reputation: 14537

As Collection is an object, you should use Set property instead of Let,
(notice the Set to assign the value) :

Public Property Set Prompts(Val As Collection)
     Set pPrompts = Val
End Property

Upvotes: 2

Related Questions