Solved

# Excel 2003 - Array Bound Error

Posted on 2011-10-30
154 Views
The below code works fine.

In a subsequent module the following line produces an error ONLY when the number of rows in UniqFoRsArr = 1 (i.e. it works fine for rows > 1)

ReDim Preserve UniqFoRsArr(UBound(UniqFoRsArr, 1), 3) ' add col 2 for rating, 3 for RCI
``````' assemble unique FoRs from FoRArts into UniqFoRsArr

Dim UniqFoRsArr(), FoRArtCounter, UniqueCounter, Test, NumRecs, AddRec, tempArr
ReDim UniqFoRsArr(1, 1)
NumRecs = 1     'tracks number of rows in UniqFoRsArr
For FoRArtCounter = 1 To UBound(FoRArts, 1) 'FoRArts is list of arts related to strMainFoR
For Each FieldItem In Array(10, 13, 16)
Test = FoRArts(FoRArtCounter, FieldItem)
If Test <> "" And Test <> strMainFoR Then  'caters for blanks and matches with strMainFoR
For UniqueCounter = 1 To UBound(UniqFoRsArr, 2) 'cycle thru UniqFoRsArr
If UniqFoRsArr(1, UniqueCounter) = Test Then
End If
Next UniqueCounter
UniqFoRsArr(1, NumRecs) = Test   'add the record
NumRecs = NumRecs + 1           'increment row count in UniqFoRsArr
ReDim Preserve UniqFoRsArr(1, NumRecs) ' need to transpose
End If
End If
Next FieldItem
Next FoRArtCounter
ReDim Preserve UniqFoRsArr(1, UBound(UniqFoRsArr, 2) - 1) 'remove trailing row
tempArr = Application.Transpose(UniqFoRsArr)
UniqFoRsArr = tempArr                    ' now UniqFoRsArr contains only unique list of FoRs
End Sub
``````
0
Question by:TigerMan

LVL 85

Expert Comment

How have you declared and initialised the array? (I suspect it's not actually an array when there's only one element - eg you assigned a range value to a variant).
0

LVL 5

Author Comment

Dim UniqFoRsArr()
ReDim UniqFoRsArr(1, 1)

That's it ... UniqFoRsArr is also declared up top as
Dim UniqFoRsArr

0

LVL 85

Expert Comment

Why is it declared twice? That gives you two different variables.
0

LVL 5

Author Comment

ok, so removed the Dim from the block of code above ... still crashes when the number of rows is 1, but works fine if 2 or more ... got me buggered :)
0

LVL 85

Expert Comment

Do you have an Option Base 1 statement? If not, Then this:

ReDim UniqFoRsArr(1, 1)

Actually declares an array with 2 rows and 2 columns. Perhaps that is your issue?
0

LVL 5

Author Comment

i do have Option Base 1

this problem has tied me up for 6 hours now ... unbelievable :)
0

LVL 85

Expert Comment

In fact, it almost certainly is as Transpose will return a 1 based array, so you'd get back an array from 1 to 2 on each dimension, rather than 0 to 1.
0

LVL 5

Author Comment

All I am trying to do with
ReDim Preserve UniqFoRsArr(UBound(UniqFoRsArr, 1), 3)
is simply add two new columns to UniqFoRsArr

Preserve keeps the data intact

When this ReDim is called UniqFoRsArr has 1 column of data by n rows (where n is between 1 and 157)
If n is > 1 then the ReDim works, and everything moves forward correctly
If n = 1 then the ReDim statement returns 'Subscript out of Range'
0

LVL 85

Expert Comment

This:
ReDim Preserve UniqFoRsArr(UBound(UniqFoRsArr, 1), 3)

is not in the code you posted as far as I can see. If it's in another module, then your problem is that UniqFoRsArr only has scope in the routine you posted above - as soon as that finishes, it gets erased. With your original double declaration, the variable existed outside this routine, but was not changed by it.

As an aside, if you are just trying to get a unique list of items, I think a Dictionary object would be a lot faster.
0

LVL 5

Author Comment

This: ReDim Preserve UniqFoRsArr(UBound(UniqFoRsArr, 1), 3) is within the same module.
I have Watched it populate etc in the above code chunk.  A more complete code chunk is attached.
It is at line XXX that the error occurs, but only when UBound(UniqFoRsArr,1) is = 1.

If we can resolve this tiny problem then I will up the points and ask more about the Dictionary thingy ... that is something I do not understand.

``````' ******************************************************************************************
' assemble unique FoRs from FoRArts into UniqFoRsArr

Dim FoRArtCounter, UniqueCounter, Test, NumRecs, AddRec, tempArr
ReDim UniqFoRsArr(1, 1)

NumRecs = 1     'tracks number of rows in UniqFoRsArr
For FoRArtCounter = 1 To UBound(FoRArts, 1) 'FoRArts is list of arts related to strMainFoR
For Each FieldItem In Array(10, 13, 16)
Test = FoRArts(FoRArtCounter, FieldItem)
If Test <> "" And Test <> strMainFoR Then  'caters for blanks and matches with strMainFoR
For UniqueCounter = 1 To UBound(UniqFoRsArr, 2) 'cycle thru UniqFoRsArr
If UniqFoRsArr(1, UniqueCounter) = Test Then
End If
Next UniqueCounter
UniqFoRsArr(1, NumRecs) = Test   'add the record (column)
NumRecs = NumRecs + 1           'increment row count in UniqFoRsArr
ReDim Preserve UniqFoRsArr(1, NumRecs) ' add new column, need to transpose
End If
End If
Next FieldItem
Next FoRArtCounter
ReDim Preserve UniqFoRsArr(1, UBound(UniqFoRsArr, 2) - 1) 'remove trailing row (column)
tempArr = Application.Transpose(UniqFoRsArr)
UniqFoRsArr = tempArr                    ' now UniqFoRsArr contains only unique list of FoRs
XXX ReDim Preserve UniqFoRsArr(UBound(UniqFoRsArr, 1), 3)

Call BubbleSort(UniqFoRsArr, True)       ' true is ascending order, false is descending
``````
0

LVL 85

Expert Comment

Do you have an Option Base 1 statement?

Your code should not work for any number of rows for the reasons I stated earlier.

This line:
ReDim Preserve UniqFoRsArr(UBound(UniqFoRsArr, 1), 3)

tries to resize and preserve an array. However, when you use Redim and Preserve, you cannot change the boundary of any dimension other than the last one. Transpose returns a 1 based array, but you are resizing without specifying a lower bound of 1, so you are effectively trying to resize the first dimension, and that is not allowed.

To simplify your issue, consider this code:
``````   Dim UniqFoRsArr()
Dim tempArr
Dim numrows           As Long
numrows = 1
ReDim UniqFoRsArr(1, 1)   ' <<-- your array is now UniqFoRsArr(0 to 1, 0 to 1)

tempArr = Application.Transpose(UniqFoRsArr)
UniqFoRsArr = tempArr   ' <<-- your array is now UniqFoRsArr(1 to 2, 1 to 2)

' this will fail because you are trying to alter the FIRST dimension (to be 0 to 2) as well as theLAST dimension.
ReDim Preserve UniqFoRsArr(UBound(UniqFoRsArr, 1), 3)

' this will work because you are not changing the size of the FIRST dimension any more
' note that BOTH dimensions are declared using '1 to n' syntax
ReDim Preserve UniqFoRsArr(1 To UBound(UniqFoRsArr, 1), 1 To 3)
``````
0

LVL 5

Author Comment

hi again ... ok, i have an hour to play
i think this is on the right track ... it has to be a declaration / bound type problem ... but not yet fixed

see below code ... both *** ReDim statements work fine no matter how many records are in UniqFoRsArr

the ### ReDim statement still crashes !!

it must be an error in this code because 50 lines further down the following code also works fine

ReDim Preserve UniqFoRsArr(UBound(UniqFoRsArr, 1), 15)

i.e. i just keep adding columns to UniqFoRsArr until i get it the way i want it to be.

Any more clues?
``````ReDim UniqFoRsArr(1 To 1, 1 To 1)

NumRecs = 1     'tracks number of rows in UniqFoRsArr
For FoRArtCounter = 1 To UBound(FoRArts, 1)
SNIP Code
UniqFoRsArr(1, NumRecs) = Test
NumRecs = NumRecs + 1
***          ReDim Preserve UniqFoRsArr(1 To UBound(UniqFoRsArr, 1), 1 To NumRecs)
End If
Next FoRArtCounter
*** ReDim Preserve UniqFoRsArr(1 To UBound(UniqFoRsArr, 1), 1 To UBound(UniqFoRsArr, 2) - 1)
tempArr = Application.Transpose(UniqFoRsArr)
UniqFoRsArr = tempArr
### ReDim Preserve UniqFoRsArr(1 To UBound(UniqFoRsArr, 1), 1 To 3)
``````
0

LVL 5

Author Comment

Also as stated above I do use Option Base 1
0

LVL 85

Accepted Solution

Ah, got it. If your array is (1 to 1, 1 to 1) then Transpose returns an array that is just (1 to 1), which is why the Redim Preserve fails. I'd change the code to this:

``````   ReDim UniqFoRsArr(1 To 1, 1 To 1)

NumRecs = 1     'tracks number of rows in UniqFoRsArr
For FoRArtCounter = 1 To UBound(FoRArts, 1)
'SNIP Code
ReDim Preserve UniqFoRsArr(1 To UBound(UniqFoRsArr, 1), 1 To NumRecs)   '***
UniqFoRsArr(1, NumRecs) = Test
NumRecs = NumRecs + 1
End If
Next FoRArtCounter
If UBound(UniqFoRsArr, 1) > 1 Or UBound(UniqFoRsArr, 2) > 1 Then
tempArr = Application.Transpose(UniqFoRsArr)
UniqFoRsArr = tempArr
End If
ReDim Preserve UniqFoRsArr(1 To UBound(UniqFoRsArr, 1), 1 To 3)   '###
``````
0

LVL 5

Author Comment

hi rorya
i have messed about with this, and it now works ... testing for columns before ReDim was the answer - i just couldn't see it so thanks!
this one has cost you a bit of time so my apologies
i am quite happy to increase the points
i also would like some advice with this dictionary thing ... i saw it elsewhere but it has not been explained clearly
can you post an example of taking an array (with repeating values) and shoving a unique set of values in this dictionary thing?  something on how to use the dictionary once it has those unique values would be cool as well
you tell me how many points this is worth then ... cool?
0

LVL 5

Author Comment

btw, here is the complete and final code block :)
``````' ******************************************************************************************
' assemble unique FoRs from thisFoRArts into UniqFoRsArr

Dim FoRArtCounter, UniqueCounter, Test, AddRec, tempArr
ReDim UniqFoRsArr(1 To 1, 1 To 1)

NumRecs = 1     'tracks number of rows in UniqFoRsArr

' outer loop through each article in thisFoRArts (all articles related to strMainFoR)
For FoRArtCounter = 1 To UBound(thisFoRArts, 1)
' inner loop through the 3 fields that contain 4FoR values or blanks
For Each FieldItem In Array(10, 13, 16)
Test = thisFoRArts(FoRArtCounter, FieldItem) ' load Test with 4FoR
If Test <> "" And Test <> strMainFoR Then  ' caters for blanks and matches with strMainFoR
' loop through each record in UniqFoRsArr to determine existence of Test
For UniqueCounter = 1 To UBound(UniqFoRsArr, 2)
If UniqFoRsArr(1, UniqueCounter) = Test Then
AddRec = False  ' if FoR in UniqFoRsArr then don't add new record
End If
Next UniqueCounter
' AddRec set to True outside loop; set to false if Test is blank or in UniqFoRsArr above
' therefore if true proceed to add new record and increment the record counter
ReDim Preserve UniqFoRsArr(1 To UBound(UniqFoRsArr, 1), 1 To NumRecs) ' new column, need transpose
UniqFoRsArr(1, NumRecs) = Test   'add the record (column)
NumRecs = NumRecs + 1           'increment row count in UniqFoRsArr
End If
End If
Next FieldItem
Next FoRArtCounter

' in cases where there is either 0 or 1 record in UniqFoRsArr, don't bother resize/ReDim
If UBound(UniqFoRsArr, 1) > 1 Or UBound(UniqFoRsArr, 2) > 1 Then
tempArr = Application.Transpose(UniqFoRsArr)
UniqFoRsArr = tempArr
End If
ReDim Preserve UniqFoRsArr(1 To UBound(UniqFoRsArr, 1), 1 To 3) 'add 2 new columns
' ******************************************************************************************
``````
0

LVL 5

Author Comment

hi rory, how would you like me to proceed with this?
0

LVL 85

Expert Comment

I'd suggest you close this question then start a new one about the Dictionary. Or just have a read of Patrick's article here: http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/A_3391-Using-the-Dictionary-Class-in-VBA.html
0

LVL 5

Author Comment

ok so a few more points ... thanks rory
0

## Featured Post

Drop Down List with Unique/Distinct Values (Part II - ComboBox or ListBox and Data Validation List Bonus!) David Miller (dlmille) Intro This article focuses on delivering unique, sorted lists to list objects (e.g., ComboBox, ListBox) and Datâ€¦
Introduction This Article briefly covers methods of calculating the NPV and IRR variants in Excel as well as the limitations in calculating and interpreting IRR results. Paraphrasing Richard Shockley, author of my favourite finance reference texâ€¦
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.