Related
I have a list of serial numbers I need to cycle through in a macro. Most of the serial numbers are consecutive, but occasionally a few will be missing. For example, I might need to use serial numbers 500-510, 512-513, 516.
Is there a way to loop through a list like that? I'd really prefer not to have to write out every number, ex: 500, 501, 502, 503... because sometimes I could have hundreds of serial numbers.
Also, the list will change with every run, so I need to be able to ask the user for the list of serial numbers and then insert that list into the vba macro. Not sure how to do that.
Thanks.
If it doesn't get much more complicated than your sample string one could refer to a Range object, e.g.:
Sub Test()
Dim str As String: str = "500-510,512-513,516"
For Each i In Range("A" & Replace(Replace(str, "-", ":A"), ",", ",A"))
Debug.Print i.Row
Next
End Sub
It may be obvious there are limitations to this approach (both length-wise on concatenating a string that represents a Range, but also on potential numbers not represented through rows on a worksheet.
Maybe a little more solid would be:
Sub Test()
Dim str As String: str = "500-510,512-513,516"
For Each el In Split(str, ",")
If InStr(1, el, "-") > 0 Then
For x = Val(el) To Val(Right(el, InStrRev(el, "-") - 1))
Debug.Print x
Next
Else
Debug.Print Val(el)
End If
Next
End Sub
As for your input string validation; You could look into Like operator or better, regular expressions.
You'll need a function that accepts a string such as "500-510,512-513,516" and returns an array of numbers represented by that expression. I haven't fully tested the below, but it appears to do the job:
Code
Function ParseNonContiguousRange(rangeExpr As String) As Long()
Dim tokens As Variant, token As Variant
Dim rangeStart As Long, rangeEnd As Long, count As Long, i As Long, index As Long
tokens = Split(rangeExpr, ",")
'First pass: count numbers in range
For Each token In tokens
If InStr(token, "-") Then
rangeStart = CLng(Split(token, "-")(0))
rangeEnd = CLng(Split(token, "-")(1))
count = count + rangeEnd - rangeStart
Else
count = count + 1
End If
Next token
Dim result() As Long
ReDim result(count + 1)
'Second pass: populate range
For Each token In tokens
If InStr(token, "-") Then
rangeStart = CLng(Split(token, "-")(0))
rangeEnd = CLng(Split(token, "-")(1))
For i = rangeStart To rangeEnd
result(index) = i
index = index + 1
Next i
Else
result(index) = CLng(token)
index = index + 1
End If
Next token
ParseNonContiguousRange = result
End Function
Sub TestParseNonContiguousRange()
Dim output() As Long
output = ParseNonContiguousRange("500-510,512-513,516")
For Each i In output
Debug.Print i
Next i
End Sub
Output
500
501
502
503
504
505
506
507
508
509
510
512
513
516
Get an array of numbers in different sequences
In addition to JvDv's valid answer an alternative approach assigning items to a 0-based 1-dim array which could be used for further processing:
Sub GetArrayOfNumbers()
Dim numbers As String: numbers = "500-510,512-513,516"
ReDim tmp(10000) ' provide for enough items in temp array
Dim number
For Each number In Split(numbers, ",") ' check each number or pair of numbers
Dim pair: pair = Split(number & "-" & number, "-")
Dim i As Long, counter As Long
For i = Val(pair(0)) To Val(pair(1))
tmp(counter) = i: counter = counter + 1 ' add number to temporary array
Next
Next number
ReDim Preserve tmp(0 To counter - 1) ' reduce to exact items count
Debug.Print Join(tmp, ",") ' (optional) display in VB Editor's Immediate Window
' ~> 500,501,502,503,504,505,506,507,508,509,510,512,513,516
End Sub
Methodical hints
In order to avoid distinguishing between single numbers and a number range, I changed any number token to a pair of numbers by re-adding the same token (prefixed by "-") to itself which simplifies splitting and the eventual assignment loop.
So splitting the last token "516-516" will allow to collect the relevant array item in a single loop step, whereas the additional appendix doesn't matter in the actual pairs of numbers (as splitting the redundant string "500-510-500-510" results in a correct values pair(0) = 500 and pair(1)=510, too).
I am just starting to learn to use VBA and I am writing a VBA code to find the average of an array with N elements. I am testing it with the array A defined at the start. If it were a MATLAB code I could use N=Length(A); and that would work, is there any function like that for VBA?
Note: I am using Option Base 1 and I am getting a 'Run-time error '13': Type mismatch
The code is as follows:
Option Base 1
Sub Question1()
A = [12,9,8,12,16,19,3,2,5,20]
i = 1
Dim N As Integer
N = UBound(A)
summ = A(1)
For i = 1 To (N - 1)
summ = summ + A(i + 1)
Next i
AVG = summ / N
MsgBox "Average is: " & AVG
End Sub
Thanks.
Declare all you variables(Consider using Option Explicit).
Use Array() not []
Option Base 1
Option Explicit
Sub Question1()
Dim A()
A = Array(12, 9, 8, 12, 16, 19, 3, 2, 5, 20)
Dim i As Long
i = 1
Dim N As Long
N = UBound(A)
Dim summ As Double
summ = A(1)
For i = 1 To (N - 1)
summ = summ + A(i + 1)
Next i
Dim AVG As Double
AVG = summ / N
MsgBox "Average is: " & AVG
End Sub
First, Dim A As Variant - always declare your variable, always start your modules with Option Explicit. You can also turn this on by default (Tools > Options > Require Variable Declaration).
Next, I believe you probably want the Array function:
A = Array(12,9,8,12,16,19,3,2,5,20)
Using [ and ] has a completely different meaning in VBA - for example [A1] will (in Excel VBA) reference cell A1 of the ActiveSheet
You don't need to do so in Excel, you could just use a worksheet function like this:
Option Explicit
Sub Test()
Dim A As Variant
A = Array(12,9,8,12,16,19,3,2,5,20)
Dim AVG As Single
AVG = Application.Average(A)
MsgBox "Average is: " & AVG
End Sub
Use always Option Explicit at the top of your module to force
yourself to declare all your variables.
Don't use integer use a Long.
UBound(array) gives you the index of the last member, LBound(array) gives you the index of the first one.
You can use the same formulas you can use on your sheet like this Application.WorksheetFunction.YourFormula but if you skip the WorksheetFunctionand give the value to an array it won't raise an error if there is one.
Although your way would be like this:
Sub Test2()
Dim A As Variant
A = [12,9,8,12,16,19,3,2,5,20]
Dim i As Long, Summ As Long
For i = 1 To UBound(A)
Summ = Summ + A(i)
Next i
AVG = Summ / UBound(A)
MsgBox "Average is: " & AVG
End Sub
First, since you're using Excel VBA, you don't need to use any special code to calculate the average of an array. You can use WorksheetFunction.Average
Option Explicit
Sub Question1()
Dim a() As Variant ' has to be a variant array, since that's what the `Array` function returns.
Dim i As Integer
Dim summ As Integer
Dim avg As Double
a = Array(12, 9, 8, 12, 16, 19, 3, 2, 5, 20)
avg = Excel.WorksheetFunction.Average(a)
MsgBox "Average is: " & avg
End Sub
If you want your code to be more portable (i.e. not have to depend on Excel's worksheet functions), then I would recommend splitting your average-calculation into a separate function you can call with any array and any base. To calculate the length of an array, you want to use both the LBound and UBound, as documented here:
n = UBound(a) - LBound(a) + 1
Assuming, of course, that a is an array, this will always work, regardless of whether your array is 0-based, 1-based, or something completely different.
Since you're looping over the array to get the sum anyways, you can also use that loop to get the length anyways. Something like this:
Option Explicit
' assuming that arr is an array containing things we can sum, to get an average.
Public Function ArrayAverage(arr As Variant) As Double
Dim n As Long, sum As Double
Dim i As Long
n = 0: sum = 0
For i = LBound(arr) To UBound(arr)
n = n + 1
sum = sum + arr(i)
Next i
ArrayAverage = sum / n
End Function
Public Sub Question1()
Dim a() As Variant, avg As Double
a = Array(12, 9, 8, 12, 16, 19, 3, 2, 5, 20)
avg = ArrayAverage(a)
MsgBox "Average is: " & avg
End Sub
Is This code correct for determining the number of elements in a single dimension variant array in Excel VBA. Supposing I have a variant array named Array1 with k elements.
Dim n as Integer
n = UBound(Array1)
To get an accurate count, you need to do UBound - LBound + 1. This is because arrays don't have to go from index 1 to n, they can start at basically any index you want. Here's an example where it goes from 3 to 7, which is a total of 5 elements (3, 4, 5, 6, and 7):
Sub tgr()
Dim Array1(3 To 7) As Variant
Dim lNumElements As Long
lNumElements = UBound(Array1) - LBound(Array1) + 1
MsgBox lNumElements
End Sub
Typically, you need the number of elements when looping through them using a For loop. In this case, the most straight forward way is to write
For i = LBound(A) To UBound(A)
Debug.Print "A(" & i & ") = " & A(i)
Next i
I have a variant like these
var = sheet1.Range("A1:P3600").Value
I have done some operarions and pushed the unwanted rows to the top in the variant. Now I have to copy the var variant to the other sheet from a certain range.
sheet1.range("A3444:P" & i).value = var(range(cells(r,"A").cells(l,"P"))
that is say var(350 to end of var) should be copied to the other sheet. Is it possible ? can we do like that ?
One way is to dump the reduced array to a second array, then the second array to your range
The code below makes a variant array with 3600 rows by 16 columns (ie A:P), data is dumped into the array for sample data (note you already have this array as Var), then a variable is used as a marker to reduce the array to a second array, the second array is then written to the range.
Updated to match your exact data locations. In your case you have Var1 already (your Var), so you just need the second portion of the code that starts at lngStop = 350 and make my code Var1 references Var
Sub TestME()
Dim Var1
Dim Var2
Dim lngCnt As Long
Dim lngCnt2 As Long
Dim lngCnt3 As Long
Dim lngCnt4 As Long
Dim lngStop As Long
Var1 = Sheet1.Range([a1], [p3600]).Value2
For lngCnt = 1 To UBound(Var1, 1)
For lngCnt2 = 1 To 16
Var1(lngCnt, lngCnt2) = "I am row " & lngCnt & " column " & lngCnt2
Next lngCnt2
Next lngCnt
lngStop = 350
ReDim Var2(1 To UBound(Var1, 1) - lngStop + 1, 1 To UBound(Var1, 2))
For lngCnt3 = lngStop To UBound(Var1, 1)
For lngCnt4 = 1 To UBound(Var1, 2)
Var2(lngCnt3 - lngStop + 1, lngCnt4) = Var1(lngCnt3, lngCnt4)
Next lngCnt4
Next lngCnt3
Sheet1.[a3444].Resize(UBound(Var2, 1), UBound(Var2, 2)).Value2 = Var2
End Sub
You can slap only a portion of your array onto the sheet, but only if that portion is at the top left of your array, i.e. only the first n columns and the first m rows. There is no straightforward way of slapping the the last n columns and the last m rows. In this case, you have to resort to transferring stuff to a second, smaller array, and then dump that onto the sheet, as in #brettdj's answer -- this works fine, but it's a bit roundabout and too much coding for my taste.
Instead, if you could push your "unwanted rows" down to the bottom of your array, then it would be a one-liner to slap the top rows of that array onto a sheet (omitting the last 350).
Here's an example where a 4 x 3 array is read in, and only the top-left 3 x 2 is slapped back onto the sheet. The secret is to make the target range smaller than the entire array.
Dim v
v = Range("A2:C5")
Range("E2:F4") = v
I'm working with a dynamic array in Excel VBA. The number of columns (m) is fixed, however, I do not know how many rows (n) will be required.
The help documents state that ReDim Preserve myArray(n, m) allows me to make m larger, but not n. However, I need to increase the number of rows (n) while preserving my data, not columns (m)!
For example, I may have a (5,20) array that I would like to expand to (10,20) while preserving my data.
It seems that if there were some way to transpose my array, do a ReDim Preserve to expand the number of "columns", then re-transpose my array, I could accomplish what I want.
Is this the correct way to do this? If so, how can I do that?
Is there a better way to accomplish what I want?
One way to do what you want is to use a 1-D array that contains 1-D arrays instead of a 2-D array. Then you can ReDim Preserve the outer array all you want. If you're returning the outer array from a function, Excel will do the right thing and coerce it to a 2-D array.
For example, the function below will return a 3x2 array to the cells it's called from:
Public Function nested()
Dim outer
outer = Array(Array(1, 2), Array(3, 4))
ReDim Preserve outer(1 To 3)
outer(3) = Array(5, 6)
nested = outer
End Function
My answer to these questions might also be useful to you: Pass multidimensional array into Excel UDF in VBA and VBA pasting 3 dimensional array into sheet
Of course, if you're not returning this from a UDF, you'll have to coerce it yourself. An easy way to do that without writing looping code is to do this:
Dim coerced
coerced = Application.Index(outer, 0, 0)
This is just calling Excel's built-in INDEX function, and the zeros mean that you want back all of your rows and all of your columns. Excel will coerce your 1-D array of 1-D arrays to a 2-D array automatically. (Caveat: there are some size limitations, but they are much bigger than 10x20.)
One way how you could sove it is indeed by a double transpose with a change on the number of columns in between. This will however only work for two-dimensional arrays. It is done as follows:
' Adding one row is done by a double transposing and adding a column in between.
' (Excel VBA does not allow to change the size of the non-last dimension of a
' multidimensional array.)
myArray = Application.Transpose(myArray)
ReDim Preserve myArray(1 To m, 1 To n + 1)
myArray= Application.Transpose(myArray)
Of course m and n can be deduced as follows:
m = UBound(myArray, 1)
n = UBound(myArray, 2)
So you use the built-in transpose functionality of Excel itself. As mentioned in the code comments, this will not work for higher order matrices.
If you are developer - what is the difference between rows and columns?
Using array(N, 2) (if you have 2 columns) is the same as array(2, N) - for which you can
ReDim Preserve arr(1 to 2, 1 to N+1).
And the difference for you (as developer) will be to put the variable from the cycle in second place, instead of the first one:
N = ubound(arr)
FOR i=1 to N
GetColumn1Value = arr(1, i)
GetColumn2Value = arr(2, i)
NEXT i
Or you want this:
N = ubound(arr)
FOR i=1 to N
GetColumn1Value = arr(i, 1)
GetColumn2Value = arr(i, 2)
NEXT i
What is the difference?
Solved my own question; here's how I got around my problem. I created a temporary array, copied the contents of myArray to the temporary Array, resized myArray, then copied the contents back from the temp array to myArray.
tempArray = myArray
ReDim myArray(1 To (UBound(myArray()) * 2), 1 To m)
For i = 1 To n
For j = 1 To m
myArray(i, j) = tempArray(i, j)
Next j
Next i
If anyone can suggest a more efficient way to do this, I'd love to hear it.
The word 'transpose' immediately leaps to mind. You could simply enter data into the 2D array by flipping the columns and rows (i.e. transpose), effectively allowing you to make n (now the number of columns, but storing row values) larger when you require.
To reference the values, say in a double loop, swap the indices around. E.g. rather go from i = 1 to n and j = 1 to m where you reference value(i, j) , use i = 1 to m and j = 1 to n.
No way to determine the number of elements in the first dimension? Bummer. For a two-dimensional array with a fixed second dimension, you might want to consider making it an array of Types ("structs" in other languages) instead. That will allow you to use Redim Preserve, and still leaves you with a reasonable way to add and access values, though you'll now be accessing the second dimension as named members of the Type rather than is index values.
coercing or Slicing doesnt seem to work with Index( or Match(Index( when i want to filter array (w/o loops) based on multiple criteria, when the size of data spans greater than 2^16 rows (~ 92000 rows).
Run-Time error '13':
Type Mismatch
Transpose doesnt work with large recordsets and so also double Transpose does not work. isn't there anyway to filter an array and grab data without resorting to multiple loops?
I am thinking of trying the dictionary way or ADO with Excel.
A Caution on Redim Preserve
The urge to use ReDim Preserve here is likely misguided. Per Ken Getz and Mike Gilbert in the VBA Developer's Handbook (2006):
Using ReDim Preserve does preserve the contents of your array as it's
being resized, but it's not a fast operation... VBA must grab a chunk
of memory for the new array and then... copy over all the items in
your original array. Finally, it releases the memory used by the
original array. You'd do best to avoid ReDim Preserve if at all
possible.
Matthew Curland, a Microsoft VB developer, similarly noted in Advanced Visual Basic 6: Power Techniques for Everyday Programs (2000):
Suppose you anticipate needing 100 items up front, but... you
suddenly need space for number 101. The first reaction is a call to
ReDim Preserve to simply make the array larger. However, this call
gets more and more painful from a performance standpoint as the system
grows. You request more and more memory and possibly touch all the
memory you've previously filled. Even if you ReDim Preserve in chunks
instead of one element at a time, you'll find that the ReDim call is
the slowest part of the system.
In other words, ReDim Preserve is not as magical as it first appears. If you add one at a time, you'll see performance problems.
Now, copying an array by looping is slower yet. According to Curland, "VB's ReDim statement maps to the SafeArrayCreate[Ex] API, ReDim Preserve maps to SafeArrayRedim, and Erase maps to SafeArrayDestroy." Those APIs are much faster than loops. However, if you have to transpose the array to get there, it probably isn't worth it.
The direct way
For copying over by loop, the following sub will work. For limited use, it should be faster than transposing.
Sub RedimPreserveRows(source As Variant, newRowBound As Long)
'For 2d arrays, this copies the old data to a new array with a new Ubound for the first dimension (rows)
Dim rowBound As Long: rowBound = UBound(source)
Dim columnBound As Long: columnBound = UBound(source, 2)
Dim fillRowBound As Long: fillRowBound = IIf(newRowBound > rowBound, rowBound, newRowBound)
Dim returnArray()
ReDim returnArray(newRowBound, columnBound)
For i = 0 To fillRowBound
For j = 0 To columnBound
returnArray(i, j) = source(i, j)
Next
Next
source = returnArray
End Sub
For more: A question on alternatives to Redim Preserve was recently asked here, and I just reviewed some other options for resizing arrays in an answer here.
An array with 2 dimensions, where the number of columns are fixed and the number of rows are dynamic, can be created like this:
Sub test2DimArray()
Dim Arr2D() As String
Dim NumberOfCol As Long
Dim I As Long, J As Long, x As Long
Dim tmpValue As String, tmpValue2 As String, tmpValue3 As String
NumberOfCol = 3
J = 1
Debug.Print "Run " & Now()
Debug.Print "Sheet content"
Debug.Print "Row col1 col2 col3"
For I = 1 To 10
tmpValue = Cells(I, 1).Value
tmpValue2 = Cells(I, 2).Value
tmpValue3 = Cells(I, 3).Value
Debug.Print I & " = " & tmpValue & " " & tmpValue2 & " " & tmpValue3
If Len(tmpValue) > 0 Then
ReDim Preserve Arr2D(NumberOfCol, 1 To J)
Arr2D(1, J) = tmpValue
Arr2D(2, J) = tmpValue2
Arr2D(3, J) = tmpValue3
J = J + 1
End If
Next
'check array values
Debug.Print vbLf; "arr2d content"
Debug.Print "Row col1 col2 col3"
For x = LBound(Arr2D, 2) To UBound(Arr2D, 2)
Debug.Print x & " = " & Arr2D(1, x) & " " & Arr2D(2, x) & " " & Arr2D(3, x)
Next
Debug.Print "========================="
End Sub
TempValue read from cells A1:A10, if there is a value in cell Ax, it redim the array with +1, and add Tempvalue to array col1, add contents in Bx to array col2 and contents in Cx to array col3. If length of Ax-value is 0, it does not add anything to the array.
Debug.print show results in the "immediate window" in the VB editor.
Without the testing lines, and adding a dynamic data-range the code can be:
Sub my2DimArray()
Dim Arr2D() As String
Dim NumberOfCol As Long, NumberOfRow As Long
Dim FirstCol As Long, FirstRow As Long, LastCol As Long, LastRow As Long
Dim I As Long, J As Long, X As Long
Dim tmpValue As String, tmpValue2 As String, tmpValue3 As String
'if cells with values start in A1
With ActiveSheet.UsedRange
NumberOfCol = .Columns.Count
NumberOfRow = .Rows.Count
End With
'if cells with values starts elsewhere
With ActiveSheet.UsedRange
FirstCol = .Column
FirstRow = .Row
LastCol = .Column + .Columns.Count - 1
LastRow = .Row + .Rows.Count - 1
End With
J = 1
For I = 1 To NumberOfRow 'or For I = FirstRow to LastRow
tmpValue = Cells(I, 1).Value 'or tmpValue = Cells(I, FirstCol).Value
If Len(tmpValue) > 0 Then
ReDim Preserve Arr2D(NumberOfCol, 1 To J)
For X = 1 To NumberOfCol 'or For X = FirstCol to LastCol
Arr2D(X, J) = Cells(I, X).Value
Next X
J = J + 1
End If
Next I
End Sub