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.
Related
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)
I am trying to capture a table via an array, and iterate through the array multiple times, changing the data in two columns through each iteration. My current code (below) is set up to iterate through the array once, changing the data in two sections (, 5) and (, 6). Unfortunately, it displays an error reading
Run-time error '9': Subscript out of range
Sub arraytest()
Dim myArray As Variant
myArray = ActiveWorkbook.Worksheets("Semesters").ListObjects("tblSemester").DataBodyRange.Value
Dim i As Integer
Dim Roww As Integer
Roww = 1
While i < 10
For Each r In myArray
myArray(i, 5) = "18/19"
myArray(i, 6) = "Fall"
Roww = Roww + 1
i = 10
Next
Wend
Worksheets("Sheet1").Range("A2", "U2").Resize(UBound(myArray, 1)).Value = myArray
End Sub
How to I edit the code to successfully iterate through the array, changing the data on the specific columns?
I think you want this:
Sub arraytest()
Dim myArray As Variant
Dim i As Integer
myArray = ActiveWorkbook.Worksheets("Semesters").ListObjects("tblSemester").DataBodyRange.Value
For i = 1 To UBound(myArray, 1)
myArray(i, 5) = "18/19"
myArray(i, 6) = "Fall"
Next
Worksheets("Sheet1").Range("A2").Resize(UBound(myArray, 1), UBound(myArray, 2)).Value = myArray
End Sub
I’m in a situation where I need to reproduce something in VBA and a bit stuck given my lack of understanding of object oriented language and VBA in general.
Problem:
I need to produce an array or vector based on a 2 column table.
The first range (column) contains unit counts.
The second range (column) contains numeric values.
I need to replicate the value based on the number of units.
For example,
if the first row contains 3 units with a value of $100
I need the array to contain $100, $100, $100.
This will need to be looped thru each row containing units.
So if row 2 contains 2 units with a value of $50
I need to complete array to be $100, $100, $100, $50, $50, and so on.
I understand this situation will require ReDim the array based on the total values. My struggle is I’ve been unable to figure out the nested for loops.
I get how to replicate the value based on the number of “units” like the below...
ReDim arr(0 To x - 1)
For i = 0 To x - 1
arr(i) = rng.Offset(0, 1).Value
Next
What is the best way to loop thru each row and replicate the values for each row in the range based on the unit count?
If anyone is familiar with R, I'm essentially looking for something that achieves the rep() function (e.g., rep(df$b, df$a)) and return the values in a single array.
Any help is greatly appreciated. Thanks
Or a one liner which uses the REPT function as you would have used in r :)
This assumes your data is in A1:B10 - the length can be made variable
s = Split(Join(Application.Transpose(Evaluate("=INDEx(REPT(B1:B10&"","",A1:A10),,1)"))), ",")
An an example, to dump the new to array to C1
s = Split(Join(Application.Transpose(Evaluate("=INDEx(REPT(B1:B10&"","",A1:A10),,1)"))), ",")
[c1].Resize(UBound(s), 1) = Application.Transpose(s)
When you say Row contains 3 units, do you mean the cell has value 3 or 3 Units? If it is 3 then you may not have to Redim the array in the loop. Simply find the sum of values in Col A which has units and Redim it in one go as shown below.
Sub Sample()
Dim ws As Worksheet
Dim Ar() As String
Dim n As Long, i As Long, lRow As Long
'~~> Change this to the relevant sheet
Set ws = Sheet6
With ws
n = Application.WorksheetFunction.Sum(.Columns(1))
ReDim Ar(t To n)
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
n = 1
For i = 1 To lRow
If Len(Trim(.Range("A" & i).Value)) <> 0 Then
For j = 1 To .Range("A" & i).Value
Ar(n) = .Range("B" & i).Value
n = n + 1
Next j
End If
Next i
For i = LBound(Ar) To UBound(Ar)
Debug.Print Ar(i)
Next i
End With
End Sub
Screenshot
And if the cell has 3 Units then you will have to store the values of Col A in an array, do a replace on Unit/Units, find the sum and finally use the above code. Here is an example
Sub Sample()
Dim ws As Worksheet
Dim Ar() As String, tmpAr As Variant
Dim n As Long, i As Long, j As Long, k As Long, lRow As Long
'~~> Change this to the relevant sheet
Set ws = Sheet6
With ws
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
tmpAr = .Range("A1:A" & lRow).Value
For i = LBound(tmpAr) To UBound(tmpAr)
tmpAr(i, 1) = Replace(tmpAr(i, 1), "Units", "")
tmpAr(i, 1) = Trim(Replace(tmpAr(i, 1), "Unit", ""))
n = n + Val(tmpAr(i, 1))
Next i
ReDim Ar(t To n)
n = 1
For i = 1 To lRow
If Len(Trim(.Range("A" & i).Value)) <> 0 Then
k = Val(Trim(Replace(Replace(.Range("A" & i).Value, "Units", ""), "Unit", "")))
For j = 1 To k
Ar(n) = .Range("B" & i).Value
n = n + 1
Next j
End If
Next i
For i = 1 To UBound(Ar)
Debug.Print Ar(i)
Next i
End With
End Sub
Screenshot
if your data is already in an array then ReDim'ing will delete it's contents. You can ReDim Preserve but it's an expensive operation, better to create a new array to put the results into.
I have assumed the data is contained within a Named Range called "Data" with Units being the first column and Values being the second column.
if your data changes regularly you can create a dynamic range using the OFFSET function i.e. =OFFSET(Sheet1!$A$1,0,0,COUNTA(Sheet1!$A:$A),2) assuming your data starts in cell A1 and there is no header row.
Sub ProcessData()
Dim DataArr() As Variant
Dim QtyColArr() As Variant
Dim ResultArr() As Variant
Dim TotalQty As Long
Dim i As Long, j As Long, k As Long
'store data into array
DataArr = Range("Data") 'assume data stored in named range called "Data"
'store Qty col into 1D array
QtyColArr = Range("Data").Resize(, 1)
'sum all qty vals
TotalQty = Application.Sum(QtyColArr)
're-size ResultsArray
ReDim ResultArr(1 To TotalQty)
'Initialize ResultsArr counter
k = LBound(ResultArr)
'loop DataArr
For i = LBound(DataArr) To UBound(DataArr)
'loop qty for current row
For j = 1 To DataArr(i, 1)
'copy value
ResultArr(k) = DataArr(i, 2)
'iterate ResultsArr counter
k = k + 1
Next j
Next i
'output to intermediate window
Debug.Print "{" & Join(ResultArr) & "}"
End Sub
I'm writing a sub in VBA that is trying to look at each element in one array and see if it shows up in another array. The first array is in rows A2:A325 in Sheet A, and the second array is over 250,000 values. I keep getting a runtime error 9: subscript out of range. My code is below
Private Sub ICD_DRG_Converter()
Dim StudyDRG() As Variant
Dim StudyICD10() As Variant
Dim element As String
Dim lLastRow, i, j, k As Long
Dim ICD10Code As String
Worksheets("Accepted DRG's").Activate
ReDim StudyDRG(1 To 325) As Variant
StudyDRG = Range("A2:A325") 'Populate the study DRG's into an array for comparison
Worksheets("full_appendix_B").Activate
lLastRow = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row 'get the last row of data for sizing our ICD 10 array
ReDim StudyICD10(1 To (lLastRow)) As Variant
StudyICD10 = Range("B2:B" & lLastRow)
'i = 0
For i = LBound(StudyICD10) To UBound(StudyICD10)
k = 1
For j = LBound(StudyDRG) To UBound(StudyDRG)
If StrComp(StudyICD10(i), StudyDRG(j), vbBinaryCompare) = 0 Then 'match between study DRG and ICD-10 DRG
Worksheets("full_appendix_B").Activate
ICD10Code = Range("A" & j).Value
Worksheets("Accepted ICD-10").Activate
Range("A" & k) = ICD10Code
k = k + 1
Exit For
End If
Next j
Next i
End Sub
The line that generates the error is:
If StrComp(StudyICD10(i), StudyDRG(j), vbBinaryCompare) = 0 Then
Any help on how to fix this would be appreciated. I've tried everything I know
When you use Range() to return a range of values into a variant array, the array is resized to match the range. So the results of
ReDim StudyDRG(1 To 325) As Variant
StudyDRG = Range("A2:A325")
is that studyDRG will have elements from 1 to 324, not 1 to 325.
Not only that, but Range() always returns a two dimensional array, even if there's only one column. So to refer to the element that corresponds to A2, you need to use StudyDRG(1,1), and A3 would be StudyDRG(1,2).
I hope this helps.
This is a console application which generates a times table with user input by asking the user to input rows and columns. I get two big errors in this code:
Value of type '1-dimensional array of 1-dimensional array of Integer' cannot be converted to '1-dimensional array of Integer' 'because '1-dimensional array of Integer' is not derived from 'Integer'
and
'jaggedArrayArray' is not declared. It may be inaccessible due to its protection level.
After some research online, I have come across two big concepts - Deep Copy and Shallow Copy - which I am still learning. I think that my main problem has to do with Sub arrayPopulateJ:
Sub arrayPopulateJ(ByVal jaggedArray() As Integer, ByVal columns As Integer, ByVal rows As Integer)
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim mult(columns) As Integer
'Populates rows in jagged array
For i = 0 To rows
jaggedArray(i) = (i + 1)
Next
'Populates columns in arrays
For i = 0 To rows
For j = 0 To columns
For k = 0 To columns
mult(k) = (j + 1) * (k + 1)
Next
Next
jaggedArray(i) = mult(columns)
Next
End Sub
If you look at the line jaggedArray(i) = mult(columns) I think I am doing what is called a shallow copy and it is making this whole thing not work. What I want to happen is I want to be able to use jaggedArray as a 1D array and put 1D arrays into its elements (in my code that would be mult(columns)). I am still new to programming and VB and I am not sure how to do this. I thought that VB would be a high enough language that the flow of logic would work this way. But as I know now that is not the case. So what can I do to pass an whole array into a array and get this to work?
FULL CODE:
Module Module1
Sub Main()
'Declarations
Dim awns As Char
Dim switchOption As Integer
Dim columns As Integer
Dim rows As Integer
Dim regularArray(,) As Integer = New Integer(,) {}
Dim jaggedArray()() As Integer = New Integer(rows)() {} 'Problem here
Dim topArray(columns) As Integer
Dim sideArray(rows) As Integer
'Starting Prompts
Console.WriteLine("Hello this program will create a times table with")
Console.WriteLine("user inputs in terms of rows and columns.")
Console.WriteLine("Pick between these two options.")
Console.WriteLine("Option 1: Times table with a regular array.")
Console.WriteLine("Option 2: Times table with a jagged array.")
Do
Console.Write("Which option do you want? ")
switchOption = Console.ReadLine
Console.WriteLine("How many columns do you want? ")
columns = Console.ReadLine
columns = columns - 1
Console.WriteLine("How many rows do you want? ")
rows = Console.ReadLine
rows = rows - 1
Console.Write(vbNewLine)
'ReDim's
ReDim regularArray(columns, rows)
ReDim jaggedArray(rows)
ReDim topArray(columns)
ReDim sideArray(rows)
Select Case switchOption
Case 1
'Array populations
arrayPopulate(regularArray, columns, rows)
singlePopulate(topArray, columns)
singlePopulate(sideArray, rows)
Dim i As Integer
Dim j As Integer
Console.Write(" ")
For j = 0 To columns
Dim top As String = topArray(j)
Console.Write(top.PadLeft(3) + ": ")
Next
Console.Write(vbNewLine)
For j = 0 To rows
Dim side As String = sideArray(j)
Console.Write(side.PadLeft(3) + ": ")
For i = 0 To columns
Dim num As String = regularArray(i, j)
Console.Write(num.PadLeft(3) + ": ")
Next
Console.Write(vbNewLine)
Next
Case 2
'Array populations
arrayPopulateJ(jaggedArray, columns, rows) 'Problem here
singlePopulate(topArray, columns)
singlePopulate(sideArray, rows)
Dim i As Integer
Dim j As Integer
Console.Write(" ")
For j = 0 To columns
Dim top As String = topArray(j)
Console.Write(top.PadLeft(3) + ": ")
Next
Console.Write(vbNewLine)
For j = 0 To rows
Dim side As String = sideArray(j)
Console.Write(side.PadLeft(3) + ": ")
Dim num As String = jaggedArrayArray(j) 'Problem here
Console.Write(num.PadLeft(3))
Console.Write(vbNewLine)
Next
End Select
Console.WriteLine("Do you want to run again y/n?")
awns = Console.ReadLine()
Loop Until awns = "n"
End Sub
Sub arrayPopulateJ(ByVal jaggedArray() As Integer, ByVal columns As Integer, ByVal rows As Integer)
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim mult(columns) As Integer
ReDim mult(columns)
'Populates rows in jagged array
For i = 0 To rows
jaggedArray(i) = (i + 1)
Next
'Populates columns in arrays
For i = 0 To rows
For j = 0 To columns
For k = 0 To columns
mult(k) = (j + 1) * (k + 1)
Next
Next
jaggedArray(i) = mult(columns)
Next
End Sub
Sub arrayPopulate(ByVal regularArray(,) As Integer, ByVal columns As Integer, ByVal rows As Integer)
'Local Declarations
Dim i As Integer
Dim j As Integer
Dim mult As Integer
For i = 0 To rows
For j = 0 To columns
mult = (i + 1) * (j + 1)
regularArray(j, i) = mult
Next
Next
End Sub
Sub singlePopulate(ByVal topArray() As Integer, ByRef count As Integer)
'Local Declarations
Dim i As Integer
Dim pop As Integer
For i = 0 To count
pop = (i + 1)
topArray(i) = pop
Next
End Sub
End Module
There is no "deep" or "shallow" copy issue here. That's a red herring.
Your first problem was that you had jaggedArrayArray in your code, but the variable was declared as jaggedArray.
The next problem that arrayPopulateJ was expecting the first parameter to be of type Integer() when it should have been Integer()().
Fixing both of this it was then just an easy matter of writing arrayPopulateJ to be:
Sub arrayPopulateJ(ByVal jaggedArray()() As Integer, ByVal columns As Integer, ByVal rows As Integer)
For i = 0 To rows
Dim column(columns) As Integer
jaggedArray(i) = column
For j = 0 To columns
jaggedArray(i)(j) = (i + 1) * (j + 1)
Next
Next
End Sub
I also cleaned up arrayPopulate to be:
Sub arrayPopulate(ByVal regularArray(,) As Integer, ByVal columns As Integer, ByVal rows As Integer)
For i = 0 To rows
For j = 0 To columns
regularArray(j, i) = (i + 1) * (j + 1)
Next
Next
End Sub
I ran your code at that point and it worked.