After adding an object to and array original objec

Question

I have a method that is adding custom objects to an array in a loop. The problem is, that the last object added to the array seems to overwrite all the other objects in the array. I have stepped through the code to see that the correct objects are added initially but I can't seem to figure out why the last object overwrites all others. I have a feeling that it has something to do with memory pointers and my CallNum object but I haven't been able to figure this one out.

Function getCallNumObjects(TotalCol As Integer) As Lib_CallNum
'
'   Find all the call numbers and their coresponding total
'
    Dim CallNumObjs() As Lib_CallNum
    Dim i As Integer

    i = 0
    Do Until ActiveCell.Value = "$<total:U>"
        If i <> 1 Or i <> 0 Then
            ReDim Preserve CallNumObjs(i) As Lib_CallNum
        End If
        Dim CallNum As New Lib_CallNum
        CallNum.Title = Replace(ActiveCell.Value & ActiveCell.Offset(1, 0).Value, " ", "")
        CallNum.Total = ActiveCell.Offset(0, TotalCol - 1).Value
        Set CallNumObjs(i) = CallNum
        ActiveCell.Offset(2, 0).Activate
        Debug.Print CallNumObjs(i).Title
        i = i + 1
    Loop

    Debug.Print CallNumObjs(0).Title
    Debug.Print CallNumObjs(1).Title
    Debug.Print CallNumObjs(2).Title



    Set getCallNumObjects = CallNumObjs
End Function

The output of this function is:

DS0000701-DS000800

LH-PK

PL001001-PL003300

The prints after the loop are:

PL001001-PL003300

PL001001-PL003300

PL001001-PL003300

Answer 1

CallNumObjs is an array of Lib_CallNum. The function assigns that array to a single instance of Lib_CallNum, not an array. Perhaps if your function was defined as:

Function getCallNumObjects(TotalCol As Integer) As Lib_CallNum()

EDIT: I incorporated the change from the comments and deleted the intermediate CallNum variable. This might at least clear out unneeded stuff for debugging. Also, I think the repeated instantiation of that variable might have caused your problem:

Function getCallNumObjects(TotalCol As Integer) As Lib_CallNum ()
    Dim CallNumObjs() As Lib_CallNum
    Dim i As Integer

    i = 0
    Do Until ActiveCell.Value = "$<total:U>"
        ReDim Preserve CallNumObjs(i) As Lib_CallNum
        CallNumObjs(i).Title = Replace(ActiveCell.Value & ActiveCell.Offset(1, 0).Value, " ", "") = CallNum
        CallNumObjs(i).Total = ActiveCell.Offset(0, TotalCol - 1).Value
        ActiveCell.Offset(2, 0).Activate
        i = i + 1
    Loop
    Set getCallNumObjects = CallNumObjs
End Function