I'm creating two arrays based on a range in my Excel sheet:
AdjustedProductionValues,
ProductionTargetValues
I'm creating a third array to hold new values:
FinalProductionValues
I want to loop through AdjustedProductionValues; if the value is 0 I want to assign the value of ProductionTargetValues to a new array FinalProductionValues. Otherwise, I want to assign the value of AdjustedProductionValues to FinalProductionValues.
I keep getting an error of Subscript out of range. I've tried ReDim a couple different ways with no success. I get the error at the If statement.
How do I fix this?
Sub TEST()
Dim AdjustedProductionValues() As Variant
Dim ProductionTargetValues() As Variant
Dim FinalProductionValues() As Variant
ReDim FinalProductionValues(1 To 1) As Variant
Dim i As Integer
'Assigning Adjusted Production and Production Target numbers into lists
Worksheets("SUMMARY").Activate
AdjustedProductionValues = Range(Range("E35"), Range("E35").End(xlToRight))
ProductionTargetValues = Range(Range("E34"), Range("E34").End(xlToRight))
'checking each Adjusted Production value
'if it's 0 then assigns the Adjusted Production value to a new list
'if it's not 0 it assignes the Production Target to the new list
For i = 0 To UBound(AdjustedProductionValues)
ReDim Preserve FinalProductionValues(1 To UBound(FinalProductionValues) + 1) As Variant
If AdjustedProductionValues(i) = 0 Then
FinalProductionValues(UBound(FinalProductionValues)) = ProductionTargetValues(i)
Else
FinalProductionValues(UBound(FinalProductionValues)) = AdjustedProductionValues(i)
End If
Next i
End Sub
UPDATE W/ FIX
I fixed my code with this:
For i = 1 To UBound(AdjustedProductionValues, 2)
ReDim Preserve FinalProductionValues(1 To UBound(FinalProductionValues) + 1) As Variant
If AdjustedProductionValues(1, i) = 0 Then
FinalProductionValues(UBound(FinalProductionValues)) = ProductionTargetValues(1, i)
Else
FinalProductionValues(UBound(FinalProductionValues)) = AdjustedProductionValues(1, i)
End If
Next i
I checked my work by using the following:
Worksheets("Sheet2").Activate
Dim NumRows As Long
Dim NumCols As Long
NumRows = 1
NumCols = UBound(FinalProductionValues, 1) - LBound(FinalProductionValues, 1) + 1
Range("A1").Resize(NumRows, NumCols).Value = FinalProductionValues
Got help checking my code with this link.
Related
I am sharing my code because other code found online either does not work because it was created for excel and not access, as syntax is a little different, or is missing the key function needed, that being based off multi selection.
That said... this code does the following:
having a list box that's row source is query results the code simply puts multiple selected items from a list box in an array to be used in later code.
The difference from excel to access is .list works in excel while .Column(0, i) works in access
Dim i As Integer
Dim x As Variant
Dim MultiArr()
If Me.lbMultiEdit.ListIndex <> -1 Then
For i = 0 To Me.lbMultiEdit.ListCount - 1
If Me.lbMultiEdit.Selected(i) Then
ReDim Preserve MultiArr(x)
MultiArr(x) = Me.lbMultiEdit.Column(0, i)
x = x + 1
End If
Next i
End If
'sanity check....
For i = 0 To x - 1
MsgBox MultiArr(i)
Next i
Your code is non-optimized. It resizes the array for every item that's added. A ReDim Preserve is a very intensive operation, because it essentially creates a new array of the desired size, and then moves all items over.
A more optimized variant, that never uses ReDim Preserve:
Dim i As Integer
Dim x As Variant
Dim MultiArr()
If Me.lbMultiEdit.ItemsSelected.Count = 0 Then Exit Sub 'No items selected
ReDim MultiArr(0 To Me.lbMultiEdit.ItemsSelected.Count - 1)
If Me.lbMultiEdit.ListIndex <> -1 Then 'Why?
For i = 0 To Me.lbMultiEdit.ListCount - 1
If Me.lbMultiEdit.Selected(i) Then
MultiArr(x) = Me.lbMultiEdit.Column(0, i)
x = x + 1
End If
Next i
End If
Rather than iterating over all items and testing whether each item is selected, you could merely iterate over only the selected items, for example:
Dim i As Integer, v, MultiArr()
ReDim MultiArr(0 To Me.lbMultiEdit.ItemsSelected.Count - 1)
For Each v In Me.lbMultiEdit.ItemsSelected
MultiArr(i) = Me.lbMultiEdit.ItemData(v)
i = 1 + i
Next v
Or, using a With statement:
Dim i As Integer, v, MultiArr()
With Me.lbMultiEdit
ReDim MultiArr(0 To .ItemsSelected.Count - 1)
For Each v In .ItemsSelected
MultiArr(i) = .ItemData(v)
i = 1 + i
Next v
End With
I have create the following code. I want verify if my arry1 is equal to "Gi0". If is correct then copy to a new arry2, but then appear the following error:
Subscript out of range
Can someone explain me what is wrong?
with :
arry2(k, 1) = arry1(i, 1)
Private Sub CommandButton1_Click()
Dim arry1() As Variant
ReDim arry2(1 To 20, 1 To 1)
arry1 = Sheets("Sheet1").Range("B2:B65").Value
k = 1
For i = 1 To UBound(ar1)
If Left(arry1(i, 1), 3) = "Gi0" Then
arry2(k, 1) = arry1(i, 1)
k = k + 1
Else
End If
Next i
End Sub
You have Ubound(ar1) and your array is called arry1.
Also, you don't need an ELSE statement in your IF.
And is that a good way to dim or redim an array? I don't think so.
If I want arry2 to be a 21 by 2 array then I say
dim arry2(20,1) as double.
If you want to dim in terms of variables I say:
dim arry2() as double
redim arry2(x,y)
hey I'm new to vba and I already tried searching for an answer to my question.
I want to fill a dynamic array with specific arrays which can be changed in the table. for that I created the following code:
Sub ZellenArrayReader()
Dim boom() As Variant
Dim rowsboom As Integer
Dim sh As Variant
sh = "TAB1"
Worksheets(sh).Range("A1").Select
rowsboom = Selection.CurrentRegion.Rows.Count - 2
ReDim boom(0 To rowsboom)
For i = LBound(boom) To i = UBound(boom)
boom(i) = Worksheets(sh).Cells(i + 2, 1)
Next i
Cells(10, 5).FormulaR1C1 = boom(0)
Cells(10, 1).FormulaR1C1 = boom(1)
End Sub
The for part is the on ewhich is not working correctly. It runs the code just one even if the Upperbound of the array is 4 or 5.
You need to change your For ... Next loop to:
For i = LBound(boom) To UBound(boom)
boom(i) = Worksheets(sh).Cells(i+2, 1)
Next i
Small modification, It work well.
Private Sub ZellenArrayReader()
Dim boom() As Variant
Dim rowsboom As Integer
Dim sh As String
sh = "TAB1"
Sheets(sh).Range("A1").Select
rowsboom = Selection.CurrentRegion.Rows.Count - 2
ReDim boom(0 To rowsboom)
For i = 0 To UBound(boom) Step 1
boom(i) = Sheets(sh).Cells(i + 2, 1)
Next i
Cells(10, 5).FormulaR1C1 = boom(0)
Cells(10, 1).FormulaR1C1 = boom(1)
End Sub
As others have answered, the i=UBound(boom) part of your for loop is causing the problem. If boom had 1 element, that would return True(i=0 and UBound(boom)=0) and it would be like For i = LBound(boom) to -1 (True is -1 when cast as a Long). That would loop zero times. In your case, you have at least two elements, so i=UBound(boom) returns False. That's like For i = LBound(boom) to 0 which is why it only executes once.
The Range.Value property returns a two dimensional array and is generally faster than looping through an array and filling it with values from cells. The lower bound of an array assigned via Range.Value is 1, not zero. Here's a rewrite of the code without the loop.
Sub ZellenArrayReader()
Dim vBoom As Variant
Dim sh As Worksheet
Dim rCurrReg As Range
Set sh = ThisWorkbook.Worksheets("TAB1")
Set rCurrReg = sh.Range("A1").CurrentRegion
vBoom = rCurrReg.Resize(rCurrReg.Rows.Count - 2).Value
sh.Cells(10, 5).Value = vBoom(1, 1)
sh.Cells(10, 1).Value = vBoom(2, 1)
End Sub
I'm trying to cumulate the sums of values in an excel column of 4 values dimension (4,1).
So, I constructed the code below. For the first row in a column on the side Result, it is supposed to hold the same value as in the original Array.
But then, once it is greater than the first row, it is supposed to get the previous element of result (i-1) and add to it the current column element (i).
VBA is telling me that the subscript is out of range :/ and I cant figure out why... so I dont even know if my code does what I want.
Sub CumulativeSum()
Dim i As Integer
Dim j As Integer
Dim rColumn() As Variant
Dim result() As Variant
ReDim result(1 To 4)
rColumn = Worksheets("Sheet1").Range("E1:E4").Value2
For i = 1 To 4
result(1) = rColumn(1, 1)
For j = 2 To 3
result(j) = rColumn(j, 1) + result(j - 1)
Next j
Next i
Dim dest As Range
Set dest = Worksheets("Sheet1").Range("F1")
dest.Resize(4, 1).Value = result
End Sub
Sub CumulativeSum()
Dim dest As Range
Dim i As Integer
Dim j As Integer
Dim rColumn() As Variant
Dim result() As Variant
ReDim result(1 To 4)
rColumn = Worksheets("Sheet1").Range("E1:E4").Value2
result(1) = rColumn(1, 1)
For j = 2 To 4
result(j) = rColumn(j, 1) + result(j - 1)
Next j
Set dest = Worksheets("Sheet1").Range("F1")
dest.Resize(4, 1).Value = Application.Transpose(result)
End Sub
Don't have enough rep to add a comment but.. the reason why you're getting an error is because the Syntax for Cells is Cells([Row],[Column]). You're typing it in as Cells([Column],[Row]).
Try Range(Cells(1, 5), Cells(4, 5)) instead.
I have been given the job of fixing a holiday spreadsheet at work, the problem with the document is that there are direct references, indirect references to other worksheets and some parts non referenced, so if you want to put people in a different order it completely messes the whole thing up. So, what I have been trying to do is to populate an array with the peoples names, sort the array, then cross reference that with the original and find a new order so that this new order can be implemented throughout the worksheets without messing things up.
The problem is that I can't seem to get the arrays to populate, I have looked at the other answers on here, but I'm sure I'm using redim properly and that tends to be the problem.
So Previous is the original listing, Current is the sorted list and Position is the number that relates the previous to the current.
Sub Sorting()
Dim Previous() As Variant
Dim Current() As Variant
Dim maxrow As Long
Dim i As Long
Dim j As Long
Dim k As Long
Dim Position() As Long
Dim rng As Range
Dim strTemp As String
k = 0
i = 3
maxrow = 3
Do While Worksheets(1).Cells(i, 1).Value <> "STAT.HOL'S (ST)"
maxrow = maxrow + 1
i = i + 1
Loop
maxrow = maxrow - 1
ReDim Previous(0 To maxrow)
ReDim Position(0 To maxrow)
ReDim Current(0 To maxrow)
Previous = Range("a4", Range("a" & maxrow))
Current = Previous
For i = 0 To maxrow
For j = 0 To maxrow
If Current(i) > Current(j) Then
strTemp = Current(i)
Current(i) = Current(j)
Current(j) = strTemp
End If
Next j
Next i
For i = 0 To maxrow
For j = 0 To maxrow
If Previous(i) = Current(j).Value Then
Position(k) = j
k = k + 1
End If
Next j
Next i
End Sub
Thanks for your help.
Amy
You do populate the arrays, but you are adressing them the wrong way.
When you assign a range to an array, the array is automatically redimensioned to a two-dimensional array, one for the rows and one for the columns.
Since your range is just one columm, the second dimension is always 1. So after you run the line Previous = Range("a4", Range("a" & maxrow)) you have an array that is dimensioned as:
Previous(1 to 10, 1 To 1)
Also, your For loops could be changed to something like this:
For i = LBound(Current, 1) To UBound(Current, 1)
Next i
Excel ranges are always treated as having 2 dimensions even when they are a single column.
Also you don't need to redim your variant arrays - just assign the range to a plain variant variable and it will create a variant containing a 2-dimensional array:
Dim Previous as variant
Previous = Range("a4:a" & maxrow)