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
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
Answer：
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.
Tags: dictionary, excel-vbaexcel, object, oop, vba
