Search code examples
vbaexceltypesmismatch

Runtime error when passing a class as a Variant argument


When I do this:

Dim data_set As DataSet
Set data_set = New DataSet
'some meaningless operations here    
list.Add CVar(data_set)

on the list.Add line, I get a run-time error 13, arguing for a type mismatch.

This is the header of the Add sub:

Public Sub Add(ByRef vItem As Variant, Optional index As Long)

What am I missing here?

EDIT: Just enabled all errors, and it fails on this piece of code, now with a Run-Time error 9:

Private Function GetListCount() As Long
    ClearError
    On Error GoTo Err
    GetListCount = UBound(mList) - LBound(mList) + 1
    Exit Function
Err:
    GetListCount = 0
End Function

And here's the mList definition:

Private mList() As Variant

EDIT2: Here's the constructor:

'==============================
'Constructor
'==============================
Public Sub Initialize()
    Disposed = False
    ReDim mList(0)
End Sub

Public Function CreateInstance() As ListClass
     Dim oNew As New ListClass
     oNew.Initialize
     Set CreateInstance = oNew
End Function

EDIT3: By request here are the entire modules... First the ListClass

Private mList() As Variant
Private mError As Error
Private mDisposed As Boolean

'==============================
'Constructor
'==============================
Public Sub Initialize()
    Disposed = False
    ReDim mList(0)
End Sub

Public Function CreateInstance() As ListClass
    Dim oNew As New ListClass
    oNew.Initialize
    Set CreateInstance = oNew
End Function

'==============================
'Properties
'==============================
Public Property Get Items(ByRef index As Long) As Variant
    Items = GetItemAtIndex(index)
End Property
    Public Property Get Count() As Long
    Count = GetListCount()
End Property

Public Property Get GotError() As Boolean
    If ListError Is Nothing Then GotError = False Else GotError = True
End Property

Public Property Get ListItems() As Variant()
    ClearError
    On Error GoTo Err
    ListItems = mList
    Exit Property
Err:
        ListError = Err
End Property

Public Property Get ListError() As Error
    ListError = mError
End Property

Private Property Let ListError(ByRef vError As Error)
    Set mError = vError
End Property

Public Property Get Disposed() As Boolean
    Disposed = mDisposed
End Property

Private Property Let Disposed(ByRef vValue As Boolean)
    mDisposed = vValue
End Property

Public Property Get ToArray()
    ToArray = mList
End Property

'==============================
'Public Methods
'==============================

Public Sub Remove(ByRef vItem As Variant)
    DeleteElement (vItem)
End Sub

Public Sub RemoveAtIndex(ByRef index As Long)
    DeleteElementAt (index)
End Sub

Public Sub Sort()
    BubbleSort (mList)
End Sub

Public Sub Clear()
    Erase mList
End Sub

Public Function Find(ByRef vItem As Variant) As Long
    Find = FindItem(vItem)
End Function

Public Sub Dispose()
    ResetError
    Clear
    Disposed = True
End Sub

Public Sub ResetError()
    ClearError
End Sub

Public Function LastIndexOf(ByRef vItem As Variant)
    LastIndexOf = GetLastIndexOf(vItem)
End Function

Public Function IndexOf(ByRef vItem As Variant)
    IndexOf = FindItem(vItem)
End Function

Public Sub Reverse()
    ReverseList
End Sub

Public Function Exists(vItem As Variant)
    Exists = ItemExists(vItem)
End Function

Public Sub Add(ByRef vItem As Variant, Optional index As Long)
    If index > 0 Then
        AddItemAt index, vItem
    Else
        AddItem vItem
    End If
End Sub

Public Function Contains(ByRef vItem As Variant)
    Contains = Exists(vItem)
End Function

Public Function Copy() As ListClass
    Set Copy = GetCopy
End Function

Public Sub RemoveAll()
    Clear
End Sub

'==============================
'Private Methods
'==============================

Private Sub ClearError()
    Set mError = Nothing
End Sub

Private Function GetListCount() As Long
    ClearError
    On Error GoTo Err
    GetListCount = UBound(mList) - LBound(mList) + 1 'and error happens here
    Exit Function
Err:
        GetListCount = 0
End Function

Private Function GetItemAtIndex(ByRef index As Long) As Variant
    ClearError
    On Error GoTo Err
    GetItemAtIndex = mList(index)
    Exit Function
Err:
        ListError = Err
    GetItemAtIndex = Nothing
End Function

Private Sub AddItemAt(index As Long, vItem As Variant)
    ClearError
    On Error GoTo Err

    Dim ar() As Variant
    Dim i As Integer

    i = Count
    ReDim ar(i)

    For a = 0 To index - 1
        ar(a) = mList(a)
    Next

    ar(index) = vItem

    For a = index + 1 To i
        ar(a) = mList(a - 1)
    Next

    mList = ar
    Exit Sub
Err:
        ListError = Err
End Sub

Private Sub BubbleSort(ByVal vArray As Variant)
    ClearError
    On Error GoTo Err

    Dim i As Long
    Dim iMin As Long
    Dim iMax As Long
    Dim vSwap As Variant
    Dim swapped As Boolean

    iMin = LBound(vArray)
    iMax = UBound(vArray) - 1

    Do
        swapped = False
    For i = iMin To iMax
        If vArray(i) > vArray(i + 1) Then
            vSwap = vArray(i)
            vArray(i) = vArray(i + 1)
            vArray(i + 1) = vSwap
            swapped = True
        End If
    Next
    iMax = iMax - 1
    Loop Until Not swapped
    mList = vArray
    Erase vArray
    Exit Sub
Err:
        ListError = Err
End Sub

Private Sub DeleteElementAt(index As Integer)
    ClearError
    On Error GoTo Err

    Dim i As Integer
    For i = index + 1 To Count - 1
        mList(i - 1) = mList(i)
    Next
    ReDim Preserve mList(Count - 2)
    Exit Sub
Err:
        ListError = Err
End Sub

Private Sub DeleteElement(ByRef vItem As Variant)
    ClearError
    On Error GoTo Err

    DeleteElementAt (FindItem(vItem))
    Exit Sub
Err:
        ListError = Err
End Sub

Private Sub AddItem(vItem As Variant)
    ClearError
    On Error GoTo Err

    Dim i As Long
    i = Count
    ReDim Preserve mList(i)
    mList(i) = vItem
    Exit Sub
Err:
        ListError = Err
End Sub

Private Function FindItem(vItem As Variant) As Long
    ClearError
    On Error GoTo Err

    FindItem = -1

    For i = 0 To Count - 1
        If mList(i) = vItem Then
        FindItem = i
        Exit For
        End If
    Next i
    Exit Function
Err:
        ListError = Err
        FindItem = -1
End Function

Private Function GetLastIndexOf(vItem As Variant) As Long
    ClearError
    On Error GoTo Err

    GetLastIndexOf = -1
    Dim i As Long

    For i = Count - 1 To 0 Step -1
        If mList(i) = vItem Then
            GetLastIndexOf = i
        Exit Function
        End If
    Next i
    Exit Function
Err:
        ListError = Err
        GetLastIndexOf = -1
End Function

Private Sub ReverseList()
    ClearError
    On Error GoTo Err

    Dim ar() As Variant
    Dim i As Long
    Dim j As Long

    If Count = 0 Then Exit Sub
    i = Count - 1
    j = i
    ReDim ar(i)

    For a = 0 To i
        ar(a) = mList(j)
        j = j - 1
    Next a

    mList = ar
    Erase ar
    Exit Sub
Err:
        ListError = Err
End Sub

Private Function ItemExists(vItem As Variant) As Boolean
    If FindItem(vItem) > -1 Then
        ItemExists = True
    Else
        ItemExists = False
    End If
End Function

Private Function GetCopy() As ListClass
    Dim list As New ListClass
    Set list = list.CreateInstance

    For i = 0 To Count - 1
        list.Add mList(i)
    Next i
    Set GetCopy = list
    i = GetCopy.Count
End Function

And now the function where the error is happening...

Function ReadData() As ListClass

    'instanteate list
    Dim list As ListClass
    Set list = New ListClass


    'get sheets
    Dim sheet As Worksheet
    Set sheet = Sheets("Data")
    Dim dataSheet As Worksheet
    Set dataSheet = Sheets("DataSet")

    'read lines and store them on list
    Dim i As Integer
    i = 2
    Do While sheet.Cells(i, 1) <> ""
        Dim data_set As DataSet
        Set data_set = New DataSet

        data_set.entry_spread = CSng(dataSheet.Cells(i, 7).Value)
        data_set.result = CSng(dataSheet.Cells(i, 12).Value)
        data_set.lot = CInt(dataSheet.Cells(i, 13).Value)
        data_set.win = IIf(UCase(dataSheet.Cells(i, 15).Value) = "YES", True, False)
        data_set.group = CInt(dataSheet.Cells(i, 20).Value)
        data_set.atr = CSng(dataSheet.Cells(i, 21).Value)
        data_set.pdr = CSng(dataSheet.Cells(i, 22).Value)
        data_set.ir = CSng(dataSheet.Cells(i, 23).Value)
        data_set.fib = dataSheet.Cells(i, 24).Value
        data_set.slipage = CSng(dataSheet.Cells(i, 25).Value)
        data_set.slipread = CSng(dataSheet.Cells(i, 26).Value)
        list.Add CVar(data_set) 'error happens here...
        i = i + 1
    Loop

    ReadData = list

End Function

Solution

  • You don't need to create your own constructor as you are not passing any arguments - so you can just use the Class_Initialize event. Replace this:

    '==============================
    'Constructor
    '==============================
    Public Sub Initialize()
        Disposed = False
        ReDim mList(0)
    End Sub
    
    Public Function CreateInstance() As ListClass
        Dim oNew As New ListClass
        oNew.Initialize
        Set CreateInstance = oNew
    End Function
    

    with this:

    Private Sub Class_Initialize()
        Disposed = False
        ReDim mList(0)
    End Sub
    

    and remember to remove this line from the GetCopy function:

    Set list = list.CreateInstance
    

    Edit: forgot to mention that because you are passing Objects, you need to use Set when assigning them to the array mList.