I'm new to VBA in excel, I write code for copying cells from sheet to an array. When I run I got run time error. I don't know whats wrong.
Sub DistSystem()
Dim count As Integer
Dim i As Integer
Dim array_rank() As Variant
Dim array_city() As Variant
Dim array_assign() As Variant
count = Sheets("111").Range("Y2").Value
For i = 0 To count
array_city(i) = Range("A" & i).Value
array_rank(i) = Range("E" & i).Value
array_assign(i) = Range("F" & i).Value
Next
For i = 1 To 10
MsgBox array_rank(i, 1)
Next
End Sub
I suspect you are going to be battle errors in multiple places.
This section of code has 2 significant problems
array_city(i) = Range("A" & i).Value
array_rank(i) = Range("E" & i).Value
array_assign(i) = Range("F" & i).Value
First you are trying to assign values to array that do not have any dimensions. You decleared the arrays but you left them dimensionless. You need to define the dimensions before you try to assign values to the array
Something like
Redim array_city(1 to count)
Next you are trying to get a value from Range("A" & i) when the value of i is zero. Cell "A0" does not exists and will also throw an error.
So to rewrite your code as written, you would need to make a few changes:
Sub DistSystem()
Dim count As Integer
Dim i As Integer
Dim array_rank() As Variant
Dim array_city() As Variant
Dim array_assign() As Variant
count = Sheets("111").Range("Y2").Value
Redim array_rank(1 to count)
Redim array_city(1 to count)
Redim array_assign(1 to count)
For i = LBound(array_rank) To UBound(array_rank)
array_city(i) = Range("A" & i).Value
array_rank(i) = Range("E" & i).Value
array_assign(i) = Range("F" & i).Value
Next
For i = 1 To 10
MsgBox array_rank(i)
Next
End Sub
However, you are over complicating how you are reading the values into the array. You can simply read the entire range directly into the array
Sub DistSystem()
Dim count As Integer
Dim i As Integer
Dim array_rank As Variant 'Notice the arrays are not longer declared with ()
Dim array_city As Variant ' -> this is necessary
Dim array_assign As Variant
count = Sheets("111").Range("Y2").Value
array_city = Range("A1:A" & count).Value
array_rank = Range("E1:E" & count).Value
array_assign = Range("F1:F" & count).Value
For i = 1 To 10
MsgBox array_rank(i, 1)
Next
End Sub
The resulting array with be 2 dimensions, with the Row value as the first dimension and the column as the 2nd dimension. since all of the ranges are a single column, you would access any value by calling array_rank(Row,1) or array_city(Row,1) or array_assign(Row,1).
Related
I think i've got a good start, but I'm having a tough time taking this to the finish line. Could someone help me out?
I have a name column(G) in my spreadsheet. I want to pull the only the last name out of each cell and assign it to an array called name_array.
I know that my If function is working because if I set each name_cell to the LastName variable it substitutes only the lastname in each cell of the column, but I cannot figure out how to assign that to the array.
Here is my code thus far. Can someone please help me out and point out what I'm missing?
Sub create_namear()
Dim name_array() As Variant
Dim name_range As Range
Dim name_cell As Range
Dim n As Long
Set name_range = ActiveSheet.Range("G2:G" & Range("G" & Rows.Count).End(xlUp).Row)
ReDim name_array(name_range.Cells.Count)
For Each name_cell In name_range.Cells
Dim Lastname As String
If InStr(name_cell, " ") > 0 Then
Lastname = Split(name_cell, " ")(1)
End If
name_array(n) = lastname.value
n = n + 1
Next name_cell
Debug.Print name_array(1)
End Sub
Name Column
Here is another way to achieve what you want without looping. I have commented the code so you should not have a problem understanding it.
BASIC LOGIC
To get the part after SPACE, you can use the formula =IFERROR(MID(G2,SEARCH(" ",G2,1),LEN(G2)-SEARCH(" ",G2,1)+1),"")
Now applying the formula in the entire range and getting the value using INDEX(FORMULA). You can find the explanation of this method in Convert an entire range to uppercase without looping through all the cells
CODE
Option Explicit
Sub Sample()
Dim ws As Worksheet
Dim rng As Range
Dim lRow As Long, i As Long
Dim FinalAr As Variant
'~~> Set this to the relevant sheet
Set ws = Sheet1
With ws
'~~> Find last row in col G
lRow = .Range("G" & .Rows.Count).End(xlUp).Row
'~~> Set your range
Set rng = .Range("G2:G" & lRow)
'~~> Get all the last names from the range and store them
'~~> in an array in 1 go!
FinalAr = Evaluate("index(IFERROR(MID(" & _
rng.Address & _
",SEARCH("" ""," & _
rng.Address & _
",1),LEN(" & _
rng.Address & _
")-SEARCH("" ""," & _
rng.Address & _
",1)+1),""""),)")
End With
'~~> Check the output
For i = LBound(FinalAr) To UBound(FinalAr)
Debug.Print ">"; FinalAr(i, 1)
Next i
End Sub
IN ACTION
ALTERNATIVE METHODS
Use Text To columns and then store the output in an array
Use Flash Fill to get the last names and then store the output in an array. One drawback of this method is that the names which do not have last name, it will show first name instead of a blank.
Sub create_namear()
Dim name_array() As Variant
Dim name_range As Range
Dim name_cell As Range
Dim n As Long
Set name_range = ActiveSheet.Range("G2:G" & Range("G" & Rows.Count).End(xlUp).Row)
ReDim name_array(0 to name_range.Cells.Count-1) '### 0-based array...
For Each name_cell In name_range.Cells
If InStr(name_cell, " ") > 0 Then
name_array(n) = Split(name_cell, " ")(1) 'simplify...
End If
n = n + 1
Next name_cell
Debug.Print name_array(1)
End Sub
Solution using Filter() (values with missing lastnames are excluded):
Sub ExtractLastNames()
Dim arr, name_array, i
arr = WorksheetFunction.Transpose(Range("G2:G" & Cells(Rows.Count, "G").End(xlUp).Row)) 'first, get the horizontal one-dimentional array from cells
name_array = Filter(arr, " ", True) 'second, filter out one-word and empty elements
For i = LBound(name_array) To UBound(name_array)
name_array(i) = Split(name_array(i))(1) 'third, replace name_array values with extracted lastnames
Next
Range("H2").Resize(UBound(name_array) + 1) = WorksheetFunction.Transpose(name_array) ' output
End Sub
Last Names to Array
The following will consider the substring after the last occurring space as the last name.
Option Explicit
Sub create_namear()
Dim ws As Worksheet: Set ws = ActiveSheet
Dim nRange As Range
Set nRange = ws.Range("G2:G" & ws.Range("G" & ws.Rows.Count).End(xlUp).Row)
Dim rCount As Long: rCount = nRange.Rows.Count
Dim nArray() As String: ReDim nArray(0 To rCount - 1)
Dim nCell As Range
Dim n As Long
Dim nmLen As Long
Dim LastSpacePosition As Long
Dim nmString As String
Dim LastName As String
For Each nCell In nRange.Cells
nmString = CStr(nCell.Value)
If InStr(1, nmString, " ") > 0 Then
LastSpacePosition = InStrRev(nCell.Value, " ")
nmLen = Len(nmString)
If LastSpacePosition < nmLen Then
LastName = Right(nmString, nmLen - LastSpacePosition)
nArray(n) = LastName
n = n + 1
End If
End If
Next nCell
If n = 0 Then Exit Sub
If n < rCount Then
ReDim Preserve nArray(0 To n - 1)
End If
Debug.Print "[" & LBound(nArray) & "," & UBound(nArray) & "]" _
& vbLf & Join(nArray, vbLf)
End Sub
Extension on Siddharth' s formula evaluation
These additions to Siddharth's valid code can be helpful, if there are less than 2 data rows in order to avoid
an unwanted evaluation of the title row 1:1 (in case of no data at all, see section 1.b) - This can be prevented by correcting a resulting row number lRow of only 1 to the actual data row start of 2.
Error 9 Subscript out of range (in case of a single element; see section 3.b) - Note that this requires to transform a 1-dim result to a 2-dim results array by means of a adequately dimensioned tmp array.
Furthermore I simplified the formula building to avoid repeated rng.Address insertions just to show another way of doing it (see section 2.).
Sub GetLastName()
'0. Set this to the relevant sheet
Dim ws As Worksheet: Set ws = Sheet1
With ws
'1. Define data range
'1. a) Find last row in col G
Dim lRow As Long
lRow = .Range("G" & .Rows.count).End(xlUp).Row
'1. b) Provide for empty data set ' << Added to avoid title row evaluation
If lRow = 1 Then lRow = 2
'1. c) Set your range
Dim rng As Range: Set rng = .Range("G2:G" & lRow)
'2. Define formula string parts ' << Modified for better readibility
Dim FormulaParts()
FormulaParts = Array("INDEX(IFERROR(MID(", _
",SEARCH("" "",", _
",1),LEN(", _
")-SEARCH("" "",", _
",1)+1),""""),)")
'3. Assign last names to 2-dim array results
'3. a) Get all the last names from the range and store them
Dim results
results = Evaluate(Join(FormulaParts, rng.Address))
End With
'3.b) Provide for single results '<< Added to avoid Error 9 Subscript o/Rng
If UBound(results) = 1 Then '<< Force single element into 2-dim array
Dim tmp(1 To 1, 1 To 1)
tmp(1, 1) = results(1)
results = tmp
End If
'h) Display in VB Editor's immediate window
Dim i As Long
For i = LBound(results) To UBound(results)
Debug.Print ">"; results(i, 1)
Next i
'i) Write last names to target '<< Added to demonstrate writing back
ws.Range("H2").Resize(UBound(results), 1) = results
End Sub
Hello there I am very new to VBA coding and coding in general so I hope you can come up with a quick answer to my problem.
I am trying to get a XLookup-Formula into my vba-Code. The code is referencing to another Sheet ("Chart Plan" and is supposed to take the values in column "D" and "E" (starting from row 2) as fixed arrays down to the last row for the "Lookup array" and "return array". I want this to be variable as the "Chart Plan" is updated with different row numbers according to what I am working on. The formula then is supposed to return the values into the active worksheet (Column "J") and go through all the rows ("B" given as RC[-8] = Lookup value).
The problem, I guess, is that I don't really know how the syntax is for giving the arrays into the formula or is it something else entirly? Mixing between RC-Annotation and A1-Annotation maybe?
Thank you.
Dim aEndKP As Variant
Dim aStartKP As Variant
Dim aCN As Variant
Sub ChartPlanScript()
Dim row As Long
Dim last_row As Long
Dim rng As Range
Dim ws As Worksheet
'Array End KP
LReKP = Sheets("Chart Plan").Cells(Rows.Count, "D").End(xlUp).row
aEndKP = Sheets("Chart Plan").Range("D2:D" & LReKP)
'Array Start KP
LRsKP = Sheets("Chart Plan").Cells(Rows.Count, "E").End(xlUp).row
aStartKP = Sheets("Chart Plan").Range("C2:C" & LRsKP)
'Array Chart Plan
LRCN = Sheets("Chart Plan").Cells(Rows.Count, "E").End(xlUp).row
aCN = Sheets("Chart Plan").Range("E2:E" & LRCN)
Set ws = Sheets(1)
ws.Activate
last_row = ws.Range("A5000").End(xlUp).row
For row = 2 To last_row
If Range("A" & row).Value > 0 Then
ws.Range("J" & row).Value = "=XLOOKUP(RC[-8],[aEndKP],[aCN],,1,1)"
Else
ws.Range("J" & row).Value = ""
End If
Next row
End Sub
I don't have XLOOKUP on my version of Excel but this would be using VLOOKUP
Option Explicit
Sub ChartPlanScript()
Dim ws As Worksheet
Dim i As Long, last_row As Long
Dim sCN As String
'Chart Plan
With Sheets("Chart Plan")
last_row = .Cells(Rows.Count, "D").End(xlUp).row
sCN = "'Chart Plan'!" & .Range("D2:E" & last_row).Address
End With
Set ws = Sheets(1)
ws.Activate
last_row = ws.Range("A5000").End(xlUp).row
For i = 2 To last_row
If ws.Cells(i, "A") > 0 Then
ws.Range("J" & i).Formula = "=VLOOKUP(B" & i & "," & sCN & ",2,0)"
Else
ws.Cells(i, "J") = ""
End If
Next
MsgBox i - 1 & " rows processed"
End Sub
I'm looking for a way to create an array in which it finds the average for columns E, F, G and H and then stores the average in an array. The only issue is the amount of rows in each column varies for each file I will run this array on (all the columns have the same amount of rows though) and so I pressure it'll be a dynamic array, and I also want the averaging to start from the second row as I have titles in the first row. If anyone knows how to do this the help would be much appreciated as I'm utterly confused.
As far as I know, empty cells doesn't count. So there is no need to define lastrow. Try this:
Sub AvToArray()
Dim rng As Range
Dim col As Range
Dim arrAv()
Dim i As Long
Set rng = Range("E:H")
ReDim arrAv(rng.Columns.Count)
For Each col In rng.Columns
arrAv(i) = WorksheetFunction.Average(col)
i = i + 1
Next col
End Sub
You can use the WorksheetFunction method for Average().
From what I understood from your question, you wanted the averages to be stored inside an array, so here you go..
Public Function lastRow(ByVal ws As Worksheet, Optional ByVal col As Variant = 1)
With ws
lastRow = .Cells(.Rows.Count, col).End(xlUp).Row
End With
End Function
Sub test()
Dim ws As Worksheet, aveArr(4) As Double
Set ws = ThisWorkbook.Worksheets(1)
'You said that you wanted to store the values to be inside an array...
With WorksheetFunction
aveArr(0) = .Average(ws.Range("E2:E" & lastRow(ws, "E")))
aveArr(1) = .Average(ws.Range("F2:E" & lastRow(ws, "F")))
aveArr(2) = .Average(ws.Range("G2:E" & lastRow(ws, "G")))
aveArr(3) = .Average(ws.Range("H2:E" & lastRow(ws, "H")))
End With
MsgBox aveArr(0) & vbNewLine & _
aveArr(1) & vbNewLine & _
aveArr(2) & vbNewLine & _
aveArr(3)
End Sub
My (very similar) solution to the others posted here:
Sub AverageArray()
Dim myarray As Variant, sht As Worksheet, lastrow As Long
Set sht = ThisWorkbook.Worksheets("Sheet1")
lastrow = sht.Cells(sht.Rows.Count, "E").End(xlUp).Row 'or F, G, H, etc.
myarray = Array(Application.Average(Range("E2:E" & lastrow)), _
Application.Average(Range("F2:F" & lastrow)), _
Application.Average(Range("G2:G" & lastrow)), _
Application.Average(Range("H2:H" & lastrow)))
Debug.Print myarray(0)
Debug.Print myarray(1)
Debug.Print myarray(2)
Debug.Print myarray(3)
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 have the following code which scans a list of raw data and for each line and if date and var (a variant I defined) are correct the row is copied and placed into the correct destination. This line to copy row is commented out. The macro worked but instead of copying the whole row I've now attempted (in the 2 lines above the commented out .copy row) to select only specific cells in the row (cells in iRow and columns M,N,O,Q,R,U,V,AB). I get the error: Wrong number of arguments or invalid property assignment. I know this is related to the 2 new lines of code I input because previously the code worked fine. Any help is appreciated, thanks!
Sub currentMonthDetail()
Dim csCount As Range
Dim b As Variant
Dim shrow As Long
Dim iRow As Long, iRowL As Long, var As Variant, iDate As Variant
Dim bln As Boolean
Dim s As String
Dim eRow As Integer
Dim i As Integer
'Import monthly data from GL008 tab to detail-----------------------------------------------------------------
Set csCount = Worksheets("Input").Range("csCount")
Sheets("GL008").Activate
iRowL = Cells(rows.count, 1).End(xlUp).Row
For iRow = 2 To iRowL
Sheets("GL008").Activate
If Not IsEmpty(Cells(iRow, 35)) Then
bln = False
var = Application.Match(Cells(iRow, 35).Value, Worksheets("Input").Columns(3), 0)
iDate = Sheets("GL008").Cells(iRow, 34)
If Not CVErr(var) = CVErr(xlErrNA) And iDate = Worksheets("Input").Range("E3") Then
Sheets("GL008").Activate
Range("M" & iRow, "N" & iRow, "O" & iRow, "Q" & iRow, "R" & iRow, "U" & iRow, "V" & iRow, "AB" & iRow).copy
'Sheets("GL008").rows(iRow).copy
s = Sheets("GL008").Cells(iRow, 35)
Sheets(s).Activate
eRow = Sheets(s).Cells(rows.count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Paste Destination:=Sheets(s).rows(eRow)
End If
End If
Next iRow
You are passing lots of cells to Range. When you try to do that, it's looking for a top-left start cell, a lower-right end cell, and will make a rectangle selection from one to the other.
Because you're trying to give it 8 separate parameters, it can't handle it. You need to give it 1 parameter, which contains the cell list; make them all into one string, and then give that string as one parameter to range.
i.e. put the commas into the text.
Range("M" & iRow & ",N" & iRow & ",O" & iRow & ",Q" & iRow & ",R" & iRow & ",U" & iRow & ",V" & iRow & ",AB" & iRow).copy