So I have an Array called TagOptions - it contains numeric values according to a pervious if statement. In order to take out values I didn't want I gave the undesired values a place holder value of 0. I am now trying to filter out this value but can't find anything online that is helpful.
Will paste the entire function for context but more interested in just filtering out the placeholder zeros from my array.
Sorry if this is novice but I am very new to this:
Private Sub CommandButton4_Click()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("TEST")
lrow = sh.Cells(Rows.count, 1).End(xlUp).Row
Dim splitstring As String
Dim holder As String
Dim myarray() As String
Dim strArrayNumber() As Integer
Dim strArrayTag() As String
Dim TagOptions() As Integer
Dim TagOptions2() As Integer
ReDim strArrayNumber(1 To lrow) As Integer
ReDim strArrayTag(1 To lrow) As String
'Initial for loop splitting tags and removing any tags with text (MV-4005A)
'Transfering those remaining tag numbers into array if they match equip selected
For a = 1 To lrow
If sh.Cells(a, 1).Value <> vbNullString Then
splitstring = sh.Cells(a, 1).Value
myarray = Split(splitstring, "-")
strArrayTag(a) = myarray(0)
End If
If IsNumeric(myarray(1)) = False Then
myarray(1) = 0
End If
If strArrayTag(a) = TagNumber1.Value Then 'Only stored if has selected Equipment tag
strArrayNumber(a) = myarray(1)
End If
Next a
'Sort Created Array
Quicksort strArrayNumber, LBound(strArrayNumber), UBound(strArrayNumber)
ReDim TagOptions(1000 To 2000) As Integer
Dim j As Integer
For j = 1000 To 2000
For b = 1 To UBound(strArrayNumber)
If strArrayNumber(b) = j Then
TagOptions(j) = 0
Exit For
Else
TagOptions(j) = j
End If
Next b
sh.Cells(j, 8) = TagOptions(j)
Next j
Quicksort TagOptions, LBound(TagOptions), UBound(TagOptions)
For f = LBound(TagOptions) To UBound(TagOptions)
sh.Cells(f, 9) = TagOptions(f)
Next f
**TagOptions2 = Filter(TagOptions, "0", False, vbDatabaseCompare)**
Me.ComboBox1.List = TagOptions
End Sub
Thnak you in advance for any help.
tl;dr entire code, just note that VBA's Filter() function applied on a "flat" 1-dim array only executes a partial character search finding "0" also in strings like e.g. "10" or "205", what definitely isn't what you want to do :-;
Btw, if your initial array is a 2-dim array, there are number of answers at SO how to slice data from a 2-dim array and transpose or double transpose them to a 1-dim array needed as starting point.
Solving the actual core question how to filter out zero-digits
To succeed in filtering out zeros in a 1-dim array, simply use the following function via the Worksheetfunction FilterXML (available since vers. 2013+):
tagOptions = WorksheetFunction.FilterXML("<t><s>" & _
Join(tagOptions, "</s><s>") & "</s></t>", _
"//s[not(.='0')]")
resulting in a 1-based 2-dim array.
If you prefer, however to get a resulting 1-dim array instead, simply transpose it via tagOptions = Application.Transpose(tagOptions) or tagOptions = WorkSheetFunction.Transpose(tagOptions).
You can find an excellent overview at Extract substrings ... from FilterXML
Related
I have a strings in column "C", starting at C2 (for example: Cat, Dog, Bird, etc...) and I don't know how many. So I am using a LRow function to find the last row with data. Currently, the last row is C63 but this is expected to be different if I run the subroutine next week or next month (Hence why I said "I don't know how many"). I want to create an array for example RTArr = Array("Cat", "Dog", "Bird", etc...) So... I was thinking something like:
Dim RTArr As Variant
LRow = r.End(xlDown).Offset(x, y).Row
With ActiveSheet
For i = 2 To LRow
str = .Range("C" & i).Value
Next i
End With
Can I populate the array with something like:
Dim RTArr As Variant
LRow = r.End(xlDown).Offset(x, y).Row
With ActiveSheet
For i = 2 To LRow
ArrNum = (i - 1)
str = .Range("C" & i).Value
RTArr(ArrNum) = str
Next i
End With
Or does this not work because of the unknown size of the array? Or do I have to use "amend" in the loop? Would I be better off using a "collection" in this case? Or going about it some other way? Can I simply set a range of cells as an array without needing to loop?
If you declare a dynamic array at first (without the size), you need to ReDim it to the needed size before populating it, which in your case will be the number of rows e.g. ReDim RTArr(numberofitems). Or use a two dimensional array ReDim RTArr(numbercolumns, numberrows).
Remember that standard arrays begin at element 0, but you can define it however you like.
Remember that when inputting ranges into array Excel creates by default a two-dimensional array
More advanced techniques are possible of course, you can do some more research about VBA arrays regarding those:
1) you could ReDim the array after each element added inside of the loop, but this is mostly useful for one dimensional arrays.
2) you could define a much bigger size of array than needed before populating it, populate it, and then shrink the array to the actual size needed.
3) note that when using two (or more) dimensions ReDim Preserve works only on the last dimension.
Pseudo code for the basic populating:
Dim arr() as Variant
'we know we want to populate array with 10 elements
ReDim arr(1 to 10)
For i = 1 to 10
'This part will insert the count from the loop into the count position in array
' eg. first element of array will be a 1, second a 2 etc. until 10
arr(i) = i
Next i
If your version of Excel supports the TEXTJOIN function:
Sub Kolumn2Array()
Dim r As Range
Dim N As Long
Dim RTArray
Dim comma As String
comma = ","
N = Cells(Rows.Count, "C").End(xlUp).Row
Set r = Range("C2:C" & N)
With Application.WorksheetFunction
RTArray = Split(.TextJoin(comma, True, r), comma)
End With
End Sub
This is my first time using array in VBA. I was trying to check the value of my array based on certain condition.
I check my array value through the Locals Window. The window is empty. What did I do wrong?
Option Explicit
Sub test()
'define dynamic array
Dim sn As Variant
Dim i As Long
'Loop through all the row
For i = 1 To Rows.Count
If Cells(i, 12).Value = "Renewal Reminder" And Not IsEmpty(Cells(i, 12).Value) Then
'assign cell value to array
sn = Cells(i, 1).Value
Debug.Print "aaa" ' there are 8 cell values that meet the condition
End If
Next i
End Sub
Update
Dim sn as Varient was highlighted with Error
user-defined type not defined
Apart from the typo showing in the error message, you are not actually using sn as an array - you are simply storing each value in a scalar variable, replacing what was previously in that variable.
The following should work for you:
Option Explicit
Sub test()
'define dynamic array
Dim sn As Variant
Dim cnt As Long
Dim i As Long
ReDim sn(1 To 1)
cnt = 0
'Loop through all the row
For i = 1 To Cells(Rows.Count, "L").End(xlUp).Row
If Cells(i, 12).Value = "Renewal Reminder" Then
'assign cell value to array
cnt = cnt + 1
ReDim Preserve sn(1 To cnt)
sn(cnt) = Cells(i, 1).Value
Debug.Print "aaa" ' there are 8 cell values that meet the condition
End If
Next i
For i = 1 To cnt
Debug.Print sn(i)
Next
End Sub
As mentioned in the answer by Chemiadel, it is better to declare your variables using the appropriate base type if you know what that is.
So, if you know that column A contains text, replace Dim sn As Variant with
Dim sn() As String
or, if it is a double-precision number, use
Dim sn() As Double
etc. If column A could contain various different types, using Variant could be appropriate.
Note: You don't have to include the () when using Variant because Variant variables can switch happily between being scalars, arrays, objects, etc.
You need to declare Array with this way and avoid Variant data type :
Static Array : fixed-size array
dim sn(10) as String
Dynamic Array : you can size the array while the code is running.
dim sn() as String
Use ReDim Preserve to expand an array while preserving existing values
ReDim Preserve sn(UBound(sn) + 10)
Check the reference
I'm trying to get a 2D array of size [x][3] filled. X is just the size of the sheet (number of rows) and there are 3 columns which I am interested in. The columns are not near each other, for instance arr[i][0] should be filled from column AA, arr[i][1] should come from column K, and arr[i][2] needs to be from columns L.
I tried assigning it the following way, but got an error in the array value assignment.
Any help on this would be greatly appreciated!
Code:
Sub SOC_work()
'Trying to sort each of the disciplines further, by Stage of Construction
Dim ar_SOC() As Variant
Dim int_NumRows As Long
Dim i_counter As Long
Dim j_Counter As Long
Dim lite As Range
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Sheets("AVEVA_PBOM_PARTS").Select
'Redimension the array size to the amount of parts in the PBOM
int_NumRows = ActiveSheet.UsedRange.Rows.count - 1
ReDim ar_SOC(int_NumRows, 3)
'now assignt he range into the array space
lite = Range("AA2", Range("AA2").End(xlDown))
ar_SOC[][1]=lite
End Sub
Is there any way to do this without looping through the entire column?
As described in the comments, you can fill three 2-D arrays. You can then populate a fourth array from the three arrays, like below.
Sub populateArray()
Dim arrColOne() As Variant, arrColTwo() As Variant, arrColThree() As Variant
Dim arrAllData() As Variant
Dim i As Long
arrColOne = Range("A2:A" & lrow(1)) 'amend column number
arrColTwo = Range("D2:D" & lrow(4))
arrColThree = Range("G2:G" & lrow(7))
ReDim arrAllData(1 To UBound(arrColOne, 1), 2) As Variant
For i = 1 To UBound(arrColOne, 1)
arrAllData(i, 0) = arrColOne(i, 1)
arrAllData(i, 1) = arrColTwo(i, 1)
arrAllData(i, 2) = arrColThree(i, 1)
Next i
End Sub
Public Function lrow(colNum As Integer) As Long
lrow = Cells(Rows.Count, colNum).End(xlUp).Row
End Function
The above will require all 3 columns to be the same length (otherwise populating the last array will not work); this is due to the fourth array being redimensioned to contain the number of elements contained in the first array.
Testing with 250,000 rows of data, the fourth array populated in 0.43 seconds.
How lenient are you with the array you get in return? I can get you a Array(col)(row)-style array, without having to loop to get it, if that works. Note that's not Array(col, row), by the way. It's a single-dimensional array of columns, with each element containing a single-dimensional array of row values. If you're okay with that, you can do this:
Dim a(1 To 3)
a(1) = WorksheetFunction.Index(WorksheetFunction.Transpose(Range("AA2:AA10")), 1, 0)
a(2) = WorksheetFunction.Index(WorksheetFunction.Transpose(Range("K2:K10" )), 1, 0)
a(3) = WorksheetFunction.Index(WorksheetFunction.Transpose(Range("L2:L10" )), 1, 0)
Then you could access your array items like so:
Debug.Print UBound(a) ' Number of columns (3)
Debug.Print UBound(a(1)) ' Number of rows in column 1
Debug.Print a(1)(3) ' Value of column 1 (AA), row 3
The Index() function can return a 1D array but only in the rows direction. So, you need to combine it with Transpose() to return a 1D column array. That's all the code above is doing.
What about an array of arrays?
Sub NoLoop()
Dim R1 As Range, R2 As Range, R3 As Range
Dim Arr1() As Variant, Arr2() As Variant, Arr3() As Variant
Dim LR As Long
LR1 = Cells(Rows.Count, "AA").End(xlUp).Row
LR2 = Cells(Rows.Count, "K").End(xlUp).Row
LR3 = Cells(Rows.Count, "L").End(xlUp).Row
Set R1 = Range(Cells(1, "AA"), Cells(LR1, "AA"))
Set R2 = Range(Cells(1, "K"), Cells(LR2, "K"))
Set R3 = Range(Cells(1, "L"), Cells(LR3, "L"))
Arr1 = R1.Value
Arr2 = R2.Value
Arr3 = R3.Value
ArrArr = Array(Arr1, Arr2, Arr3)
End Sub
With this you can call your values using:
MyVal = ArrArr(0)(1,1)
MyVal = ArrArr(0)(2,1)
MyVal = ArrArr(1)(1,1)
Where the first number is for the array (starts from 0 and ends with 2) and the second number is for row/cell of the range used to fill array.
The third number is always 1 (because adding a range to an array returns a bidimensional array)
With this code you can also have different dimensions for each column so to save memory.
Here is what I am trying to do in Excel.
Simply put, I am trying to take a 2D array, (1) convert it into a 1D array, (2) cycle through the 1D array, (3) copy any values that aren't specific strings to a new array, and (4) then write that new, trimmed 1D array to a specific column.
More complexly put, I am trying to take two 2D arrays, convert them both into matched 1D arrays, cycle through them both, but only copy the contents based on one of the arrays into two different arrays, and then write the new arrays into two different columns (didn't explain that all that well...)
With my rudimentray VBA knowledge, cobbled together from what I can find online, I have somehow managed to write some code that accomplishes (1), (2), and (4). The issues I am having is with (3). I can not seem to get it to skip over the specific cells.
Does anyone have any advice for how this can be done?
Below is the code I cobbled together. Be forewarned, this is the first code I have written, so I am guessing that there are far simpler and more elegant ways to do this; I did what worked for me. Any advice on tweaks would be greatly appreciated!
Sub Calculating()
'Transforming 2D Arrays into 1D Arrays
'Defining the arrays
Dim InputNameArray() As Variant 'Input Names (strings)
Dim InputValueArray() As Variant 'Input Values (numbers)
Dim InputArrayR As Long 'Old Array Row
Dim InputArrayC As Long 'Old Array Column
Dim OldArrayP As Long 'Old Array Position
Dim OldNameArray() As Variant 'One Dimensional Names
Dim OldValueArray() As Variant 'One Dimensional Values
InputNameArray = Range("B3:M10")
InputValueArray = Range("B27:M34")
OldArrayP = 0 'Old Array One Dimensional Position
For InputArrayR = 1 To UBound(InputNameArray, 1)
For InputArrayC = 1 To UBound(InputNameArray, 2)
ReDim Preserve OldNameArray(0 To OldArrayP)
OldNameArray(OldArrayP) = InputNameArray(InputArrayR, InputArrayC)
ReDim Preserve OldValueArray(0 To OldArrayP)
OldValueArray(OldArrayP) = InputValueArray(InputArrayR, InputArrayC)
Debug.Print OldArrayP; OldNameArray(OldArrayP), OldValueArray(OldArrayP)
OldArrayP = OldArrayP + 1
Next InputArrayC
Next InputArrayR
'Scanning through 1D Arrays to Eliminate Specific Values
'Defining New Arrays
Dim NewNameArray() As Variant 'New Name Array (Strings)
Dim NewValueArray() As Variant 'New Value Array (Numbers)
Dim NewArrayP As Long 'New Array Position
Dim OldArrayPosition As Long 'Old Array Position
NewArrayP = 0
For OldArrayPosition = LBound(OldNameArray) To UBound(OldNameArray)
If OldNameArray(OldArrayPosition) <> "Blank" Or OldNameArray(OldArrayPosition) <> "Standard-100" Or OldNameArray(OldArrayPosition) <> "Standard-50" Or OldNameArray(OldArrayPosition) <> "Standard-25" Or OldNameArray(OldArrayPosition) <> "Standard-12.5" Or OldNameArray(OldArrayPosition) <> "Standard-6.25" Or OldNameArray(OldArrayPosition) <> "Standard-3.125" Or OldNameArray(OldArrayPosition) <> "Standard-1.5625" Or OldNameArray(OldArrayPosition) <> "Standard-0.7825" Then
ReDim Preserve NewNameArray(0 To NewArrayP)
NewNameArray(NewArrayP) = OldNameArray(OldArrayPosition)
ReDim Preserve NewValueArray(0 To NewArrayP)
NewValueArray(NewArrayP) = OldValueArray(OldArrayPosition)
Debug.Print OldArrayPosition, OldNameArray(OldArrayPosition), OldValueArray(OldArrayPosition)
Debug.Print NewArrayP, NewNameArray(NewArrayP), NewValueArray(NewArrayP)
NewArrayP = NewArrayP + 1
End If
Next OldArrayPosition
'Outputing Values
'Defining Variables
Dim OutputPosition As Long 'Output Array Position
Dim OutputRow As Long 'Output Row
OutputRow = 3
For OutputPosition = LBound(NewNameArray) To UBound(NewNameArray)
Cells(OutputRow, "O").Value = NewNameArray(OutputPosition)
Cells(OutputRow, "Q").Value = NewValueArray(OutputPosition)
Debug.Print OutputRow, OutputPosition, NewNameArray(OutputPosition), NewValueArray(OutputPosition)
OutputRow = OutputRow + 1
Next OutputPosition
'Cleaning Up
Erase InputNameArray
Erase InputValueArray
Erase OldNameArray
Erase OldValueArray
Erase NewNameArray
Erase NewValueArray
End Sub
Your code is quite logical. The bug is the use of Or in the If statement; switch those to And and the code should work.
You can avoid manipulating all those arrays, perhaps something like the below. I named the input ranges to make it a little easier to resize them. If you like that, you might want to do the same for the output range.
Although I know it's quite standard VBA practice, I really, really dislike exceptions as flow control, hence the long-winded Exists method; you might prefer the alternatives mentioned here. (It will make no difference in performance for such small sets of data).
Finally, I've been a little lazy. There are plenty of "best practice" resources online that you might like to have a read through, for example this.
Option Explicit
Private Function Exists(ByRef col As Collection, ByRef key As Variant) As Boolean
Dim Iter As Long
For Iter = 1 To col.Count
If key = col.Item(Iter) Then
Exists = True
Exit Function
End If
Next Iter
Exists = False
End Function
Sub Calculating()
Dim NamesToSkip As Collection
Dim NameArray As Range
Dim ValueArray As Range
Dim OutputRange As Range
Dim Rows As Long
Dim Columns As Long
Dim Row As Long
Dim Column As Long
Dim Iter As Long
Set NamesToSkip = New Collection
NamesToSkip.Add "Blank"
NamesToSkip.Add "Standard-100"
NamesToSkip.Add "Standard-50"
NamesToSkip.Add "Standard-25"
NamesToSkip.Add "Standard-12.5"
NamesToSkip.Add "Standard-6.25"
NamesToSkip.Add "Standard-3.125"
NamesToSkip.Add "Standard-1.5625"
NamesToSkip.Add "Standard-0.7825"
Set NameArray = Range("InputNames")
Set ValueArray = Range("InputValues")
Set OutputRange = Range("O3")
Rows = NameArray.Rows.Count
Columns = NameArray.Columns.Count
If Rows <> ValueArray.Rows.Count Or Columns <> ValueArray.Columns.Count Then
Err.Raise vbObjectError + 513, "Calculating()", "Mismatched sizes of input arrays"
End If
Iter = 1
For Row = 1 To Rows
For Column = 1 To Columns
If Not Exists(NamesToSkip, NameArray.Cells(Row, Column)) Then
OutputRange.Cells(Iter, 1) = NameArray.Cells(Row, Column)
OutputRange.Cells(Iter, 3) = ValueArray.Cells(Row, Column)
Iter = Iter + 1
End If
Next Column
Next Row
Set NamesToSkip = Nothing
End Sub
I'm a bit new at this. How would I take the column and put the cell data of which is an integer and go through all values in that range to put it into a function to output the result into another column in the excel workbook. So my output column will be the entire Comm column using columns G, J and K for inputs into the function =100000*slotNumber+300*xpos+ypos
A B C D E F G H I J K
1 Proc Equip Operat Shift Comm Casette SlotNumber Diam Measure XPos YPos
2
3'
So thought if I took the values of each and made a for loop I could take the values and somehow do all this, just not sure how! Please and thank you!
EDIT: I have all columns stored, now I must pass the Array values into the function one by one, for the formula Z = 100000*slotArr(i)+300xList(i)+yList(i) or maybe I can just place it in the for loop.
EDIT: Having placed the function in the loop...I am getting an object out of range error...at the line of the function.
Sub cmdMeans_Click()
Dim i As Long, j As Long
Dim slotList As Range, slotArr() As Variant, xList As Range, xArr() As Variant
Dim yList As Range, yArr() As Variant, cArr() As Variant
Set slotList = Range("P2", Range("P2").End(xlDown))
slotArr() = slotList.Value
Set xList = slotList.Offset(0, 4)
xArr() = xList.Value
Set yList = slotList.Offset(0, 5)
yArr() = yList.Value
'Only one counter required because of the dependancy on the range slotList
For i = 2 To UBound(slotArr, 1)
'Dimensioning Array
ReDim cArr(UBound(slotArr, 1), 1)
cArr(i, 1) = (100000 * slotArr(i, 1)) + (300 * xList(i, 1)) + yList(i, 1)
'MsgBox ("Comment Cell Value" & cArr(i, 1))
Next
'Resizing Array
ReDim Preserve cArr(i)
'This is where the new values will be written to the comment column
Dim cRng As Range
Set cRng = Range(Cells(14, 1), Cells(UBound(cArr(i))))
cRng.Value = Application.Transpose(cArr)
End Sub
I get worried to look at your sample - appolgy but really not decipherable... So I stick with your question title and comment:
VBA Excel Store Range as Array, extract cell values for formula. Offset for other variables.
How store Range as Array:-
Dim vArray as Variant
vArray = Sheets(1).Range("A2:G50").Value)
How to pass array into a function that takes an array as a parameter and returns an array:-
Function passArray(ByRef vA as Variant) as Variant
Dim myProcessedArray as Variant
'----your code goes here
passArray = myProcessedArray
End Function
Output Single Dimensional array to worksheet Range:-
Sheets(1).Range("E2").Resize(1, _
UBound(Application.Transpose(singleDArray))) = singleDArray
Output Multi Dimensional array to worksheet Range:-
Sheets(1).Range("E2").Resize(UBound(multiDArray) + 1, _
UBound(Application.Transpose(multiDArray))) = multiDArray