How to prevent dynamic array from including a blank first element - arrays

I'm really struggling with why my array keeps including an empty element as its first element.
I'm populating an array from the selected choices in a listbox and I keep getting an empty first element in the array. I'm not getting any empty elements afterwards, just for the first element.
I've looked at lots of code to remove an empty element, all of which is beyond my understanding of arrays at this point, but that is not ideally for what I'm looking: I'm looking to prevent that empty element from appearing in my array in the first place.
Would anyone please help me understand what I need to change? I've tried using Option Base 1 and iterating from 1 instead of 0, but I get an error when trying to do so. Additionally, I did Redim my array as (0 To 0) and (0 to UBound) as well but nothing changed from my code below.
I'm assuming it has to do with the way I'm iterating through my listbox elements but I'm not sure how to fix the issue.
ReDim Part_Number_Array(1 To 1) As Variant
For Selected = 0 To Part_Number_Select.ListCount - 1
If Part_Number_Select.Selected(Selected) = True Then
ReDim Preserve Part_Number_Array(1 To UBound(Part_Number_Array) + 1) As Variant
'Add Part Number to the Array
Part_Number_Array(UBound(Part_Number_Array)) = _
Part_Number_Select.List(Selected)
'UpperBoundCount = UBound(Part_Number_Array)
'MsgBox "The upper bound is " & UpperBoundCount
End If
Next Selected
Thanks in advance for your help.

That is a known vb limitation which causes us all some "Empty/not empty" and member-count issues.
I have dealt with this by:
Define a class with Add/Delete/Find/etc methods no showing the array and provide a Count property. Also, you can use a Collection (and then there are some interesting derivatives, like the Dictionaries)
OR
OPTION BASE 0 (to be more C like) and use a _Count variable, initialized to 0, to keep track exactly how many useful items does the array hold and do Redims 0 to NewCount+1.

I think it is because you are redimming 1 to 1 outside the loop, then inside the loop you are redimming again before adding another element to it, then when you do add the element you are using the ubound. So it seems what happening is, you're redimming 1 to 1, which gives the array 1 empty slot. then, inside the loop you are redimming it 1 to UBound(Part_Number_Array) + 1). the + 1 at the end adds another slot (ubound is currently 1, 1 + 1 = 2) and then, when you add the element you are using Part_Number_Array(UBound(Part_Number_Array)) = so that statement puts the element at the ubound of the array, which is 2, leaving the first spot blank.
The solution:
ReDim Part_Number_Array(1 To 1) As Variant
For Selected = 0 To Part_Number_Select.ListCount - 1
If Part_Number_Select.Selected(Selected) = True Then
'Add Part Number to the Array before redimming, thus putting the new element in the 1 empty slot
Part_Number_Array(UBound(Part_Number_Array)) = _
Part_Number_Select.List(Selected)
'UpperBoundCount = UBound(Part_Number_Array)
'MsgBox "The upper bound is " & UpperBoundCount
ReDim Preserve Part_Number_Array(1 To UBound(Part_Number_Array) + 1) As Variant
End If
Next Selected
then, after the loop you can do - ReDim Preserve Part_Number_Array(1 To UBound(Part_Number_Array) - 1) notice the minus 1, this will eliminate the last slot (which is empty because of having a redim statement without adding another element)

Related

Is there a way to transfer all values from one array to another, then erase the original array?

I'm running into a problem with a block of code I'm trying to develop at my job. Essentially, I'm creating a userform in excel where folks will enter data for railcars as they get loaded at a certain location (we'll call these "spot 1, spot 2, spot 3, etc.").
Sometimes they'll have to move that car to a different spot, in which case I want them to be able to keep all the information on the railcar from the first/original entry, and then erase the data from the original spot once that's done.
To accomplish this in a more streamlined fashion, I've established arrays for each of the 5 spots that reference all the cells they're entering data into on the userform:
Dim spot1information(14)
spot1information(0) = UserForm.ProductType1.Value
spot1information(1) = UserForm.ProductID1.Value
spot1information(2) = UserForm.BatchID1.Value
etc....
Dim spot2information(14)
spot2information(0) = UserForm.ProductType2.Value
spot2information(1) = UserForm.ProductID2.Value
spot2information(2) = UserForm.BatchID2.Value
etc....
And so forth for all five spots. I don't know if this makes things more difficult, but note that these array values aren't all of the same type. For instance, index (0) will be a string, but index (10) is a DATETIME and index (12) is defined as Long.
So say that they are moving a car from spot 1 to spot 2. In short, I want the code to do the following:
Replace the values of indices 0 - 6 in spot2information (which is currently empty) with the values of indices 0 - 6 in spot1information (which the user has filled on the userform).
I'm only interested in carrying over indices 0-6 because they contain the pertinent railcar information
Empty every value of spot1information to ""
To accomplish this, I tried the following code and a few variations thereof:
If OriginalSpot.Value = 1 Then
If DestinationSpot.Value = 2 Then
For i = 0 to 6
spot2information(i) = spot1information(i)
Next
For Each i in spot1information
spot1information(i) = ""
Next
End If
End If
However, this keeps coming up with a type mismatch. I figure because the data in the spot2information array is empty, and the data in the spot1information array is not, but I'm not entirely sure of a way around this.
Update: I did what was suggested below and replaced: spot1information(i) = "" with Erase spot1information
The code now essentially works! The values of array "spot2information" are now the former values of "spot1information", with "spot1information" now empty.
The 2D array suggested below also works like a charm. New problem I've been facing is that array values are updating, but the userform isn't. (note: in the future I'll be posting this type of thing as a separate question, my apologies!)
Easier to manage this as a 2D array:
Sub Tester()
Dim spots(1 To 5, 0 To 14), n As Long, i As Long
'fill your spot arrays from the form....
For n = 1 To 5
spots(n, 0) = UserForm.Controls("ProductType" & n).Value
spots(n, 1) = UserForm.Controls("ProductID" & n).Value
spots(n, 2) = UserForm.Controls("BatchID" & n).Value
'etc etc
Next n
'swap a spot with another
Debug.Print spots(2, 1), spots(3, 1)
SwapSpots spots:=spots, fromSpot:=2, toSpot:=3
Debug.Print spots(2, 1), spots(3, 1)
End Sub
Sub SwapSpots(spots, fromSpot As Long, toSpot As Long)
Dim n As Long
For n = 0 To 6
spots(toSpot, n) = spots(fromSpot, n)
spots(fromSpot, n) = Empty 'empty the source slot value
Next n
End Sub
Assuming the DataType of the arrays is the same by Index i.e. index(0) is string for all spots, Index(2) is long for all spots, and so on.
If that is the case then this part should not produce any error:
For i = 0 to 6
spot2information(i) = spot1information(i)
Next
The error should be happening in this part more precisely in the line marked with #
For Each i in spot1information
spot1information(i) = "" '#
Next
and the reason for the error it seems to be that trying to assign a string value "" to a numeric type, given the "mismatch" error.
Using For Each i in spot1information indicates that you want to "Initiate" or Erase the entire array, therefore I suggest to use this line instead of the For…Next method.
Erase spot1information
In regards this:
But I've now run into a new problem, where the values on the userform haven't updated to reflect the new values stored in the array. Do I need to somehow "refresh" the userform?
You just updated the arrays, then you need to run the procedures used to update the values of the objects affected by both arrays in the UserForm.

Adding slide numbers to an array based off criteria

I'm at hair pulling out stage and have conceded that I need someone with far greater knowledge and understanding than me to push this over the line!
This is a bit of a two part question - the first is specifically about this code but the second question is really, am I even going about this in the right way? Either way, I'd still love to figure out what's wrong with my code so I can get better.
Desired code objective: To search through every slide in a presentation looking for a shape with the name 'Update' and another shape named 'Monthly' or 'Weekly' (for example) on the same slide. Once it finds these shapes, I'll run a seperate bit of code to manipulate that specific slide (this code is already finished and works perfectly).
My intended solution: First loop through every slide looking for the shape named 'Update'. This shape will always be on the slide when needed but the 'monthly'/'weekly' shape is a name which changes according to the update frequency required. Once the 'Update' shape is found, add that slide number to an array. Once finished doing the whole presentation, then check those slides in the array again and see if a shape exists named either 'Monthly', 'Weekly' etc. and call code accordingly.
My problem: The code does find the shape named 'Update' successfully but I cannot work out how to get the slide numbers into the array.
This code works but it makes every element of the array equal to the final slide number. So for example, if a presentation has 3 slides with 'update' and the last slide number is 7, the array would end up returning array(0) = 7, array(1) = 7, array(2) = 7. As I've stepped through, it is redimensioning the array size correctly and using the right slide number until it finds the next slide with 'update' and then it overwrites itself and uses the new slide number for every part of the array.
Sub New_test()
' Code objectives:
' Figure out which slide has the shape named "Update"
' Add that slide to an array with the corresponding slide number in
' Loop through each slide in that array, see if slide contains the shape named "Monthly"
' If so, run another macro
Dim myArr() As Variant
Dim oShape As Shape
Dim i As Long, j As Long
ReDim myArr(0)
For i = 1 To ActivePresentation.Slides.Count
For Each oShape In ActivePresentation.Slides(i).Shapes
If oShape.Name = "Update" Then
ReDim Preserve myArr(UBound(myArr) + 1) 'Redim the size of the array
j = j + 1
For j = LBound(myArr) To UBound(myArr) 'Begin looping through the array
myArr(j) = ActivePresentation.Slides(i).SlideNumber 'Assign SlideNumber value to array
Next j
End If
Next oShape
Next i
For i = 0 To UBound(myArr)
Debug.Print "Array:"; myArr(i)
Next i
End Sub
Final question - am I going about this the right way?
This code has come after a long time trying to think of a way of doing this and it seems to me to be the most sensible way, however, I'm entirely self-taught and only been using VBA often for a year so aware I may not be thinking like a programmer yet.
I initially tried to do a really simple 'For each' loop but couldn't figure out how to make the code loop back through a slide once it found the shape named 'Update' and then act accordingly as to whether the second shape was on the slide named 'Monthly', 'Weekly' etc. Any advice on an alternative approach I hadn't thought of would also be greatly appreciated.
To answer the immediate problem, change this:
For i = 1 To ActivePresentation.Slides.Count
For Each oShape In ActivePresentation.Slides(i).Shapes
If oShape.Name = "Update" Then
ReDim Preserve myArr(UBound(myArr) + 1) 'Redim the size of the array
j = j + 1
For j = LBound(myArr) To UBound(myArr) 'Begin looping through the array
myArr(j) = ActivePresentation.Slides(i).SlideNumber 'Assign SlideNumber value to array
Next j
End If
Next oShape
Next i
to this:
For i = 1 To ActivePresentation.Slides.Count
For Each oShape In ActivePresentation.Slides(i).Shapes
If oShape.Name = "Update" Then
If ExistSpecialShape(ActivePresentation.Slides(i) then
ReDim Preserve myArr(UBound(myArr) + 1) 'Redim the size of the array
End if
' Your original loop was assigning the value of J to every element in the array
' every time you invoked the loop; that's why you filled it with the last slide number
' And use SlideIndex rather than SlideNumber.
' SlideNumber is the number that appears on printouts and such.
' Normally it's the same as SlideIndex, but if the user has chosen to start
' slide numbering at something other than 1, your results will be cockeyed.
' SlideIndex won't change in that situation.
myArr(Ubound(myArr)) = ActivePresentation.Slides(i).SlideIndex 'Assign SlideNumber value to array
End If
Next oShape
Next i
After the End Sub to this subroutine, add
ExistSpecialShape(oSl as Slide) as Boolean
Dim oSh as Shape
For each oSh in oSl.Shapes
Select Case oSh.Name
Case Is = "Monday"
ExistSpecialShape = True
Exit Function
Case Is = "Wednesday"
ExistSpecialShape = True
Exit Function
' and so on, one case for each shape name you want to test
End Select
Next
End Function
Another thing to consider is that users can easily change the name of shapes using the selection pane, and PPT can be sloppy about adding multiple shapes with the same name if users dupe a shape.
You might want to read up on Tags. More reliable than shape names, more flexible and not accessible to users.
There's a bit of basic info about Tags in the PPT FAQ I maintain here:
Working with Tags (and a bit about Functions)
https://www.pptfaq.com/FAQ00815_Working_with_Tags_-and_a_bit_about_Functions-.htm

LotusScript ans Two dimensional Array & subscription out or range error

Hello I have two dimensional array as below in LotusScript.
Counter = 0
While Not (ProcessingViewDoc Is Nothing )
Redim Preserve AllRecrods(Counter,0)
AllRecrods(Counter,0) = ProcessingViewDoc.Test1(0)
Redim Preserve AllRecrods(Counter,1)
AllRecrods(Counter,1) = ProcessingViewDoc.Test2(0)
Redim Preserve AllRecrods(Counter,2)
Set ProcessingViewDoc = ProcessingView.GetNextDocument(ProcessingViewDoc)
Counter = Counter +1
Wend
When It processes next document it does and reaches to counter 1 and second document it gives me error subscription out of range.
Here is global declaration of array.
Dim AllRecrods() As Variant
Here is the line when it gives error when it goes to loop second time.
Redim Preserve AllRecrods(Counter,0)
In addition to Richard's excellent answer, I would suggest a couple of things.
1) Instead of While Not (ProcessingViewDoc Is Nothing) (which contains two negatives, making it harder to read), use Do Until doc Is Nothing. It is much clearer.
2) If you use a list, you don't have to worry about redim of the array. You could make it a list of a custom data type, and if you use the UNID of the document as the key, you can quickly connect the values back to the originating document.
My code would look something like this:
--- Declarations ---
Type recordData
value1 As String
value2 As String
End Type
--- Main Code ---
Dim allRecords List As recordData
Dim unid as String
Do Until ProcessingViewDoc Is Nothing
unid = ProcessingViewDoc.UniqueID
allRecords(unid).value1 = ProcessingViewDoc.Test1(0)
allRecords(unid).value2 = ProcessingViewDoc.Test2(0)
Set ProcessingViewDoc = ProcessingView.GetNextDocument(ProcessingViewDoc)
Loop
You are using ReDim with the Preserve option and changing both of the dimensions. You can't do that.
From the documentation for the ReDim statement:
If Preserve is specified, you can change only the upper bound of the
last array dimension. Attempting to change any other bound results in
an error.
Also, the logic there is screwed up. You're doing three redims on every iteration, with the first one shrinking the second dimension back to zero on every iteration. Even if you weren't changing the first dimension, that would lose the data that you stored in AllRecrods( n ,1) because the preserve option can't keep data in a dimension that you shrink below the size that you've already used!
You should probably consider swapping your two dimensions, reversing them in your assignments, keeping the first dimension constant at 2, and eliminating two of your ReDim Preserve statements. I.e., just do one ReDim Preserve AllRecrods(2,counter) on each iteration of the loop.

Error 9 using ReDim Preserve

This function returns a error 9, why? I already read couple of similar questions here but nothing really explained me well.
I'm really trying to understand why ReDim Preserve doesnt work in this case because from "j+1" onwards no input is made(i already checked my cells), so isnt overwriting nothing.
Heres the code
Function DadosAnoIndenizações()
ReDim dados(1 To 10000, 1 To 2)
j = 0
For i = 5 To 10000
If (IsNumeric(Worksheets(2).Cells(i, 8).Value) And Not IsEmpty(Worksheets(2).Cells(i, 8).Value)) Then
Ano = CInt(Right(Worksheets(2).Cells(i, 8).Value, 4))
SD = Worksheets(2).Cells(i, 11).Value
j = j + 1
dados(j, 1) = Ano
dados(j, 2) = SD
End If
Next i
ReDim Preserve dados(1 To j, 1 To 2)
DadosAnoIndenizações = dados
End Function
Thanks for any help guys
You are trying to change the first dimension of the array. Redim preserve can only change the last dimension of the array, which is why you're getting the error. You can find this information listed MSDN's website: ReDim Statement (Visual Basic), specifically the "Resizing with Preserve" section:
Resizing with Preserve. If you use Preserve, you can resize only the
last dimension of the array. For every other dimension, you must
specify the bound of the existing array.
For example, if your array has only one dimension, you can resize that
dimension and still preserve all the contents of the array, because
you are changing the last and only dimension. However, if your array
has two or more dimensions, you can change the size of only the last
dimension if you use Preserve.
Typically the way around that is to have the first dimension be your 1 to 2 and the second dimension be your 1 to j and then do a Application.Transpose when writing the results to the worksheet.

changing size of 2D array with vba

I always have trouble with Arrays which is why I usually avoid them but this time I'm trying to get my head round them
I'm trying to change the size of my Global Array inside vba
I have declared it using Public UseArr() As String
Now I've written a function that searches an SQL table and returns user information as a record set.
I want to take this record set and put it into my Global Array
This is the bit of code I've written for populating it
a = 0
If Not Not UseArr Then
For i = 0 To UBound(UseArr)
If StrComp(UseArr(i, 0), rs("Alias")) = 0 Then a = 1
Next i
b = i
Else
b = 0
End If
If a = 0 Then
ReDim Preserve UseArr(0 To b, 0 To 10)
With rs
If Not .BOF And Not .EOF Then
For j = 0 To 10
If Not rs(j) = "" Then
UseArr(b, j) = rs(j)
Else
UseArr(b, j) = "Null"
End If
Next j
End If
End With
End If
The idea being if the user is already in there it doesn't populate, and if not it populates.
It works fine for initialising the Array however when I go to put in a second user it throws a resize error.
Can anyone help?
Thanks in advance
Tom
Update with Dictionary Attempt
If UseList Is Nothing Then
Set UseList = New Dictionary
MsgBox "Created New"
End If
If UseList.Exists(rs("Alias")) Then
Dim temp()
For i = 0 To 10
temp(i) = rs(i + 1)
Next i
With UseList
.Add Key:=rs("Alias"), Item:=temp
End With
End If
Debug.Print UseList
You can only Redim Preserve the last dimension of a multi-dimensional array - see here. Have you considered using a Collection or Dictionary instead?
edit: using the code you've posted above, here's how you would display element 4 from the array associated with the key "tom"
MsgBox UseList("tom")(4)
or equivalently
MsgBox UseList.Item("tom")(4)
Here you have some explanation about how a Dictionary object works and some of its attributes and functions.
I think it's the best to reach your goal because they are so easy to use, fast and efficient.
First you have to import the mscorlib.dll into the Project References.
After you can use something like this to declare the dictionary:
Dim UseDict As Dictionary
Set UseDict = New Dictionary
To know if the Key you're searching is not in the Dictionary and then add the new user:
If Not UseDict.Exists(Key) Then
UseDict.Item(Key) = 1
End If
The Value is not important here, but if you wanted to count how many times a key appears somewhere, you could increment the value when UseDict.Exists(Key) = True.
That's what the Dictionaries, Hash-maps or Maps stand for: count and search efficiently.
Hope it helps!
I attach a code with some corrections. I think the problem is that you are trying to access to an array as if it was a variable. That means you have to loop through the item of a key.
I add comments to the code below:
Update
If UseList Is Nothing Then
Set UseList = New Dictionary
MsgBox "Created New"
End If
If UseList.Exists(rs("Alias")) Then
'i think is better to specify the data type and the dimension.
Dim temp(10) as string
'if you loop from 0 to 10 the array will have 11 elements
For i = 0 To 9
temp(i) = rs(i + 1)
Next i
'This will work also and looks nicer (in my opinion) than the method
'you pasted, but if that worked anyway don't change it ;)
UseList(rs("Alias")).Item = temp
End If
Now, if you want to retrieve the result you must:
For i = 0 To UBound(UseList.Item(rs("Alias")) - 1
Debug.Print UseList.Item(rs("Alias"))(i)
Next i
Give me feedback when you test the code, please :)

Resources