0

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

Community
  • 1
  • 1
ferics2
  • 5,241
  • 7
  • 30
  • 46
  • One thing to note is that the line: If i <> 1 Or i <> 0 Then will always be true, which is good, otherwise those elements wouldn't get filled. I think you can just delete it. – Doug Glancy Apr 02 '12 at 01:31
  • Those would not always evaluate to true, The loop goes through more than 2 times on many occasions. So sometimes i > 1 – ferics2 Apr 02 '12 at 02:00
  • What I meant was that i is always not equal to 1 or not equal to 0. If i equals 1, it's not equal to 0 and vice-versa, so the statement always evaluates to True. I believe you mean to use an AND statement. But if you do, then the array won't be dimensioned until i hits 2, and your code will fail on the line: Set CallNumObjs(i) = CallNum, when i = 0 or i = 1. – Doug Glancy Apr 02 '12 at 02:09
  • Good call, you were right I didn't need the if. – ferics2 Apr 02 '12 at 02:34
  • Sadly, I can't see why you're getting the debug.print results you describe. I'm going to edit my answer with a more common coding structure though and see if that helps. – Doug Glancy Apr 02 '12 at 02:36
  • Turns out it was a weird answer I needed to change my initialization of my Lib_CallNum object from: Dim CallNum As New Lib_CallNum To: Dim CallNum As Lib_CallNum Set CallNum = New Lib_CallNum But I am unsure why the first initialization would not work. Could anybody answer this for me? – ferics2 Apr 02 '12 at 02:39
  • Perhaps because you kept declaring it as New, but never set it to Nothing. I started to just fix that in my answer, but don't think you need that intermediate variable at all. Just fill the array directly. – Doug Glancy Apr 02 '12 at 02:49

2 Answers2

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
Doug Glancy
  • 27,214
  • 6
  • 67
  • 115
0

I also ran into this issue when adding new custom class objects to an array, and while this post did point me to the answer, it was a bit buried. So, I'm clarifying it here. The issue was with how each new object to be added to the array was initialized.

instead of initializing the object like this:

Dim CallNum As New Lib_CallNum

we need to do this:

Dim CallNum As Lib_CallNum
Set CallNum = New Lib_CallNum

Seems unnecessarily verbose, but at least it works.

tyler-gloski
  • 1