Set dict = CreateObject("Scripting.Dictionary") loop until the number of sheet

Question

I have an excel document that contains multiple sheets. When I run the loop Jumping after returning from the first sheet to the second sheet. But on the second sheet does not open a new dictionary and I get an error like "run time error 9" at ln 16. MySeries(Cnt, 2) = Dt(j, 2)

What can I do for each sheet in the opening of the new dictionary ?

        Dim Cll As Object
        Dim j As Integer
        Dim y As Integer, MySeries, Dt, MySeries1, MySeries2, MySeries3, MySeries4 As Integer, sum As Double
        For y = 1 To (Worksheets.Count - 1)
        Sheets(y).Select
        Ln = Sheets(y).Range("a1").End(4).Row
        Sheets(y).Range("d2:H" & Ln).Interior.ColorIndex = xlNone
        Dt = Sheets(y).Range("d2:h" & Ln).Value
        Set Cll = CreateObject("Scripting.Dictionary")
        ReDim MySeries(1 To Ln, 1 To 5)
           For j = 1 To UBound(Dt, 1)
                Fnd = Dt(j, 1)
                If Not Cll.exists(Fnd) Then
                    Cnt = Cnt + 1
                    Cll.Add Fnd, Cnt
                    ReDim Preserve MySeries(1 To Ln, 1 To 5)
                     MySeries(Cnt, 1) = Dt(j, 1)
                     MySeries(Cnt, 2) = Dt(j, 2)
                     MySeries(Cnt, 3) = Dt(j, 3)
                     MySeries(Cnt, 4) = Dt(j, 4)
                End If
               MySeries(Cll.Item(Fnd), 5) = MySeries(Cll.Item(Fnd), 5) + Dt(j, 5) / 1000
            Next j
            Sheets(y).Range("a2:h" & Ln).Clear
            Sheets(y).Range("d2").Resize(Cll.Count, 5) = MySeries

        Next y

Thank you for your help

How about using early binding instead of late binding by setting the reference to `Microsoft Scripting Runtime`? Then you can `Dim Cll As Scripting.Dictionary` and later on use `Set Cll = New Dictionary`. — Ralph, Aug 04 '16 at 21:35
I have tried the method you say. When i used early binding gives this error 'User-defined type not defined' — Hakan Sevinc, Aug 04 '16 at 21:46
If you wish to use early binding then you'll have to set the reference in the VBE to `Microsoft Scripting Runtime`. Here is a short instruction how to do that: http://stackoverflow.com/a/3236348/1153513 Once you have added this reference the above suggested code should be recognized / work. — Ralph, Aug 04 '16 at 21:54

score 1 · Accepted Answer · edited May 23 '17 at 11:44

cnt never gets reset to 0 anywhere in this code. Whilst this may or may not be desired behaviour for the items in the dictionary, it leads to the value of cnt exceeding the bounds of the MySeries array (which is based on ln and gets reset on each new sheet).

So, if ln was 20 for the first sheet and 15 for the second sheet, adding the first item on the second sheet will be equivalent to this:

Cnt = Cnt + 1 ' new value = 21
Cll.Add Fnd, Cnt ' should be OK
ReDim Preserve MySeries(1 To Ln, 1 To 5) ' MySeries is now (1 to 15, 1 to 5)
MySeries(Cnt, 1) = Dt(j, 1) ' MySeries(21, 1) exceeds the bounds of the array

It's not clear why this would fail on the MySeries(Cnt, 2) = Dt(j, 2) line as it should fail on the previous line instead - MySeries(Cnt, 1) = Dt(j, 1)

edit: as per Comintern's answer, ReDim Preserve can only change the final dimension so MySeries would get redimensioned to (1 to 20, 1 to 5) but would still fail because cnt exceeds the bounds of the array

You are absolutely right, I added `Cnt=1`per loop it solved. Thank you `For y = 1 To (Worksheets.Count - 1) Cnt = 1 Sheets(y).Select` — Hakan Sevinc, Aug 04 '16 at 22:56

score 1 · Answer 2 · answered Aug 04 '16 at 23:06

Redim Preserve can only change the upper-most bound of a 2 dimensional array. The reason has to do with how the data elements are laid out in memory. Consider the following array declaration:

Dim foo(1 to 4, 1 to 2)

In memory, it looks like this:

Now take the following statement:

ReDim Preserve foo(1 to 4, 1 to 3)

What happens is that the VBA runtime copies the data area and expands its allocated memory to allow adding additional elements (or truncates it if the 2nd dimension gets smaller). The new data area looks like this (new elements in blue):

Notice that the method of indexing by pointer offset stays the same. You will still get the same elements back with base_address + (index_one * index_two).

Now consider this statement:

ReDim Preserve foo(1 to 5, 1 to 2)

That gives the following layout in memory (new elements in red):

Notice that there isn't a contiguous area of memory that is being preserved. Also, the indexing of the array changes - base_address + (index_one * index_two) no longer points at the same elements once you change the first dimension's bound. So, VBA disallows the ReDim with Preserve on everything except the last dimension and throws the somewhat cryptic "Subscript out of range" error.

So, getting to your code - the line ReDim Preserve MySeries(1 To Ln, 1 To 5) will always fail if the value of Ln changes. The only work-arounds are to manually copy the array if you need Preserve, or wipe the array and start with a fresh one.

If the same sheet you're saying is absolutely correct. but in this line `Ln = Sheets (y) .Range (" a1 "). End (4) .Row` Ln fixed for each new sheet does not change. Ln just changing the sheet isn't it. by the way i am Chemist :D and I'm not good enough for software. — Hakan Sevinc, Aug 04 '16 at 23:37
@HakanSevinc - I assumed this was in a larger loop that wasn't posted. If `Ln` can't change, the line `ReDim Preserve MySeries(1 To Ln, 1 To 5)` doesn't actually do anything. I'd remove it to avoid a needless memory copy. That said, glad your issue is resolved - I'll leave the answer in case somebody else stumbles across this. — Comintern, Aug 04 '16 at 23:41

Set dict = CreateObject("Scripting.Dictionary") loop until the number of sheet

2 Answers2

Linked