I want to apply the WorksheetFunction.Small on another array as such:
ReDim ArrSmall(Iterations, 20)
For l = 1 To Iterations
For k = 1 To 20
ArrSmall(l, k) = WorksheetFunction.Small(ArrResult(l, k), l)
Next k
Next l
I know this part: ArrResult(l,k), is wrong because it asks for a range instead of a single number which I'm inputting. However, I am unsure how to define the range in the code.
Is this possible or do I have to output the values on a TempSheet, then back into an array? I think a solution is to call the whole column of the array but I do not know how.
EDIT:
I managed to write a dummy code which does exactly what I want but the weird part is when I apply the same to my original code, all the values get mixed up (it literally makes up values AFAIK). See below for code:
Sub test()
ReDim ArrTest(10, 1)
ReDim ArrSmall(10, 1)
ArrTest = Range("A1:A10")
For i = 1 To 10
ArrSmall(i, 1) = WorksheetFunction.Small(ArrTest, i)
Cells(i, 2) = ArrTest(i, 1)
Cells(i, 3) = ArrSmall(i, 1)
Next i
Trying to clear the whole array before a new loop. Maybe that fixes it...
If you were looking to take the smallest value of each column (which is the same as Min) from say A1:T20 then you could use TRANPOSE (to work with columns rather than rows) and then INDEX to separate each column, i.e.
The IF test is to avoid applying SMALL to an empty array (else an error results).
Sub B()
Dim ArrSmall(1 To 1, 1 To 20)
Dim lngCnt As Long
Dim ArrResult
ArrResult = Application.Transpose([a1:t20].Value2)
For lngCnt = 1 To UBound(ArrResult, 2)
If Application.Count(Application.Index(ArrResult, lngCnt)) > 0 Then _
ArrSmall(1, lngCnt) = WorksheetFunction.Small(Application.Index(ArrResult, lngCnt), 1)
Next
End Sub
Related
I am creating a dashboard of charts in Excel. There is no need for the data to be visible to end users, so I am attempting to use arrays to set SeriesCollection.Values. Here is the offending code block:
'test sub to declare and pass header_arr and series_arr
Sub test()
Dim arr1(), arr2() As Variant
With ThisWorkbook.ActiveSheet
arr1 = .Range(.Range("I2"), .Range("AI2")).Value
arr2 = .Range(.Range("I25"), .Range("AI28")).Value
End With
Call CreateWaterfall(arr1, arr2, , , , Range("I30"))
Erase arr1, arr2
End Sub
'sub to create chart
Sub CreateWaterfall(header_arr As Variant, series_arr As Variant, Optional colors As Boolean = True, Optional target_wb = Nothing, Optional target_ws = Nothing, Optional target As Range = Nothing)
'whole bunch of parameter checks that work fine
'trim header_arr
Dim temp() As Variant
ReDim temp(LBound(header_arr, 1) To LBound(header_arr, 1), LBound(header_arr, 2) To UBound(header_arr, 2))
For i = LBound(header_arr, 2) To UBound(header_arr, 2)
temp(LBound(header_arr, 1), i) = header_arr(1, i)
Next i
ReDim header_arr(LBound(temp, 1) To LBound(temp, 1), LBound(temp, 2) To UBound(temp, 2))
For i = LBound(temp, 2) To UBound(temp, 2)
header_arr(LBound(temp, 1), i) = temp(LBound(temp, 1), i)
Next i
'declare chart object, start with block...
'...stuff that works...
For i = 1 To 4
With .SeriesCollection(i)
If LBound(series_arr, 1) = 0 Then i = i - 1 'handle base 0 case-operation is reversed at end of loop to avoid incorrect steps
ReDim temp(LBound(series_arr, 1) To LBound(series_arr, 1), LBound(series_arr, 2) To UBound(series_arr, 2))
For j = LBound(series_arr, 2) To UBound(series_arr, 2)
temp(LBound(series_arr, 1), j) = series_arr(i, j)
Next j
.Values = temp '<--problem with this line
.XValues = header_arr
End With
If LBound(series_arr, 1) = 0 Then i = i + 1
Next i
'...other stuff that works...
'end with block
End Sub
This is within a With block that creates the chart and sets its properties. All of the rest of the sub is working properly, even the line here that sets .XValues, but none of the .Values are correct. When I check them on the spreadsheet itself, they are a series of 0s and #N/As. Checking revealed that this is not because of empty cells in the ranges the arrays are populated form. For the debugging phase I'm in, series_arr and header_arr are populated using a spreadsheet range; that will not be the case in the final draft. Here is a small example of the kind of data I want the sub to handle (I'm sorry; I don't know how to make it prettier than this...):
215.56 empty empty empty 432.73
empty 43.184 empty 56.442 empty
empty 136.65 186.8 345.67 empty
empty empty 87.653 empty empty
All the arrays contain the correct data as ascertained by stepping through the code.
I've looked here already and am stuck; as far as I can tell, the .Values line is exactly analogous. I've also used exactly analogous code for other charts with the exception that .Values is set using a spreadsheet range, so I know the problem isn't there.
Any ideas?
I was able to figure it out myself: it was a variant array vs. array of variants problem. I added some code to force the data within temp when it is used to set SeriesCollection.Values into type double. The final block in the snippet I originally posted is now:
Dim dbl As Double '<--var to hold contents of series_arr in loop
Dim j As Integer
For i = 1 To 4
With .SeriesCollection(i)
If LBound(series_arr, 1) = 0 Then i = i - 1 'handle base 0 case-operation is reversed at end of loop to avoid incorrect steps
ReDim temp(LBound(series_arr, 2) To UBound(series_arr, 2))
For j = LBound(series_arr, 2) To UBound(series_arr, 2)
If series_arr(i, j) = "" Then '<--convert series_arr recs
temp(j) = 0
Else
dbl = series_arr(i, j)
temp(j) = dbl
End If
Next j
.Values = temp
.XValues = header_arr
End With
If LBound(series_arr, 1) = 0 Then i = i + 1
Next i
And it works! Here is my (relatively) educated guess as to why; I would appreciate someone who knows better giving a better answer, though.
Variables of type Variant are in principle implicitly convertible to type Double, but they are also implicitly convertible to type String (among others). This means that Empty records are ambiguous; when Excel has to decide to convert it to "" or 0, it needs some other criteria to fall back on.
I thought that the fact that temp, when being used to set .Values, contained some numbers would cause Excel to convert the Empty records to 0, but I guess this isn't the case. My conclusion is that Excel will only convert array elements of type Variant to the correct type if all of them are convertible to only one other type. Thus header_arr was correctly converted to type String, even when I tested this hypothesis by removing one of the elements of header_arr. series_arr, on the other hand, since it contained elements that were convertible to type Double only but also elements that were convertible to several number types, did not convert properly.
Source
Below is some code I wrote to handle arrays and ranges uniformly (Accepting a range as an array parameter). It contains a function called sanitise which is meant to be a function you can call on some 2D collection of numbers A, and get the same numbers back as a 2D array of Doubles.
Public Function item(ByRef A As Variant, i As Integer, j As Integer) As Double
If TypeName(A) = "Range" Then
item = A.Cells(i, j)
Else
item = A(i, j)
End If
End Function
Public Function rows(ByRef A As Variant) As Integer
If TypeName(A) = "Range" Then
rows = A.rows.Count
Else
rows = UBound(A, 1) - LBound(A, 1) + 1
End If
End Function
Public Function cols(ByRef A As Variant) As Integer
If TypeName(A) = "Range" Then
cols = A.columns.Count
Else
cols = UBound(A, 2) - LBound(A, 2) + 1
End If
End Function
Public Function sanitise(ByRef A As Variant) As Double()
Debug.Print TypeName(A)
If TypeName(A) = "Double()" Then
sanitise = A
Else
Debug.Print rows(A)
Dim B() As Double
ReDim B(1 To rows(A), 1 To cols(A))
Dim i As Integer, j As Integer
For i = 1 To rows(A)
For j = 1 To cols(A)
B(i, j) = item(A, i, j)
Next j
Next i
sanitise = B
End If
End Function
The implementation works exactly as you'd expect it: select a range in the worksheet, say A1:B2, call sanitize on it and you'll have two copies of the same thing:
What goes wrong however, is sanitise^2.
Calling sanitise twice breaks down, but only if you call it on single row. Multiple rows: fine, single column: fine.
I know why it happens: after the first sanitise, Excel forgets what shape array was returned. (It also forgets the type: instead of Double() the input to the second sanitise is Variant())
Does anybody know how to work around this issue?
While it's unlikely that I'd ever want to use sanitise twice in a row, the above example illustrates why it's difficult to compose two functions along a 2 dimensional array.
Note: this is issue only happens when sanitise is called from a worksheet.
Update, I've figured it out: for the worksheets 1D storage in synonymous with row, so that needs to be taken into consideration
My final version:
Public Function get_2D(ByRef A As Variant) As Double()
'turns various forms of input into a 2D array of Doubles
Dim result() As Double
Dim i As Integer
If TypeOf A Is Range Or dims(A) = 2 Then
ReDim result(1 To rows(A), 1 To cols(A))
Dim j As Integer
For i = 1 To rows(A)
For j = 1 To cols(A)
result(i, j) = item(A, i, j)
Next j
Next i
Else
'1D storage is treated as a row
ReDim result(1 To 1, 1 To rows(A)) 'rows(A) gets length of the first axis
For i = 1 To rows(A)
result(1, i) = A(i)
Next i
End If
sanitise = result
End Function
dims is a function that returns the number of dimensions of an array: https://support.microsoft.com/en-us/kb/152288
I think this is somewhat aligned with your specification and it has the benefit of solving the single row problem you demonstrate. Would it work for your purposes?
Function sanitise_sugg(inp As Variant) As Variant
Dim result As Variant
If TypeOf inp Is Object Then
result = inp.Value
Else
result = inp
End If
sanitise_sugg = result
End Function
Edit: Taking one step back I think you should divide the task at hand into two: First use "sanitise_sugg" to use excel ranges and excel-vba arrays interchangeabely. Then if you for a special need demand the input to specifcally be some sort of Array of doubles, write a separate function that tests and if possible casts a variant input to this type.
Edit 2: Taking one step forward instead, let me claim that in the case the elements fed to Function sanitise_sugg(inp As Variant) As Variant contain doubles from within vba, or cells with numeric values from an excel sheet, it meets the specifciation demanded for Public Function sanitise(ByRef A As Variant) As Double()
Edit 3: To see how the function keeps track of its input Array layout independently of beeing Row vector, Column vector or full Matrix, independently of beeing passed the Array from an excel range or from within VBA, please refer to the below worksheet;
I can't think of any practical use for this unless you do a lot of calculations on the 2D array of Doubles, so if you give more information on what exactly you are trying to do, we can probably recommend something easier/better/more efficient etc.
.Value and .Value2 return 2D Variant array when more than one cell in the range:
v = [a1:b1].Value2 ' Variant/Variant(1 to 1, 1 to 2)
v = [a1:a2].Value2 ' Variant/Variant(1 to 2, 1 to 1)
v = [a1].Value2 ' Variant/Double
so a naive approach can be something like:
Function to2D(v) As Double()
'Debug.Print TypeName(v), VarType(v)
Dim d2() As Double, r As Long, c As Long
If IsArray(v) Then
If TypeOf v Is Range Then v = v.Value2
ReDim d2(1 To UBound(v, 1), 1 To UBound(v, 2))
For r = 1 To UBound(v, 1)
For c = 1 To UBound(v, 2)
If IsNumeric(v(r, c)) Then d2(r, c) = v(r, c)
Next c
Next r
Else
ReDim d2(1 To 1, 1 To 1)
If IsNumeric(v) Then d2(1, 1) = v
End If
to2D = d2
End Function
and tested with:
d2 = to2D([a1:b2])
d2 = to2D([a1:b1])
d2 = to2D([a1:a2])
d2 = to2D([a1])
d2 = to2D(1)
d2 = to2D([{" 1 ";" 2.0 "}]) ' works with strings too
d2 = to2D([{1,2;3,4}])
'd2 = to2D([{1,2}]) ' doesn't work with 1D arrays
I have a very large array in VBA which includes a lot of 0 values that I'd like to remove. Something like this:
A B C 12345
D E F 848349
G H I 0
J K L 0
M N O 0
P Q R 4352
S T U 0
V W X 0
I would like to be able to quickly/easily strip out all rows from this array that have a zero in the 4th column, resulting in something like this:
A B C 12345
D E F 848349
P Q R 4352
This array has 100,000 or so rows, that hopefully gets down to a number closer to 20,000 or 30,000 rows instead after processing.
I assume iterating through every entry will prove very time-consuming.
Is there another way that is faster?
I'm not aware of any other way in VBA than to loop through the array and write another array/list.
What makes it trickier is that your array looks to be two-dimensional and VBA will only allow you to redim the last dimension. From the look of your data, you'd want to redim the first dimension as you iterate through your array.
There are several solutions:
Iterate your data twice - once to get the array size (and probably to store the relevant row numbers) and a second time to transfer the raw data into your new data.
Iterate once and just reverse your dimensions (ie row is last).
Use an array of arrays, so that each array only has one dimension).
Use a Collection which doesn't need to be dimensioned - this would be my preferred option.
Option 4 would look like this (I've assumed your array is zero based):
Dim resultList As Collection
Dim r As Long
Set resultList = New Collection
For r = 0 To UBound(raw, 1)
If raw(r, 3) <> 0 Then
resultList.Add Array(raw(r, 0), raw(r, 1), raw(r, 2), raw(r, 3))
End If
Next
If you have to write to a new array, then here's an example of Option 1:
Dim rowList As Collection
Dim result() As Variant
Dim r As Long
Dim c As Long
Dim v As Variant
Set rowList = New Collection
For r = 0 To UBound(raw, 1)
If raw(r, 3) <> 0 Then
rowList.Add r
End If
Next
ReDim result(rowList.Count - 1, 3) As Variant
c = 0
For Each v In rowList
result(c, 0) = raw(v, 0)
result(c, 1) = raw(v, 1)
result(c, 2) = raw(v, 2)
result(c, 3) = raw(v, 3)
c = c + 1
Next
Okay, it's all off-sheet, so all the arrays are zero-based. To test this set-up, I created a worksheet with four columns, as per your data and using random numbers in the fourth column. I saved this to a text file (TestFile.txt), then read it in to be able to get a zero-based array (Excel ranges are 1-based when you take them into an array). I saved 150000 rows to the text file to properly stress the routine. Yes, I have an SSD and that would affect the 2s run time, but I'd still expect it to run in <10s on a spinning HDD, I think.
Anyway, here's the code (requires a VBA reference to Microsoft Scripting Runtime purely to read in the file):
Public Function ReturnFilteredArray(arrSource As Variant, _
strValueToFilterOut As String) As Variant
Dim arrDestination As Variant
Dim lngSrcCounter As Long
Dim lngDestCounter As Long
ReDim arrDestination(UBound(arrSource, 1) + 1, UBound(arrSource, 2) + 1)
lngDestCounter = 1
For lngSrcCounter = LBound(arrSource, 1) To UBound(arrSource, 1)
' Assuming the array dimensions are (100000, 3)
If CStr(arrSource(lngSrcCounter, 3)) <> strValueToFilterOut Then
' Hit an element we want to include
arrDestination(lngDestCounter, 1) = arrSource(lngSrcCounter, 0)
arrDestination(lngDestCounter, 2) = arrSource(lngSrcCounter, 1)
arrDestination(lngDestCounter, 3) = arrSource(lngSrcCounter, 2)
arrDestination(lngDestCounter, 4) = arrSource(lngSrcCounter, 3)
lngDestCounter = lngDestCounter + 1
End If
Next
ReturnFilteredArray = arrDestination
End Function
Sub TestRun()
Dim fso As FileSystemObject
Dim txs As TextStream
Dim arr As Variant
Dim arr2 As Variant
Dim lngCounter As Long
Debug.Print Now()
Set fso = New FileSystemObject
Set txs = fso.OpenTextFile("E:\Users\Thingy\Desktop\TestFile.txt", ForReading)
arr = Split(txs.ReadAll, vbNewLine)
ReDim arr2(UBound(arr), 3)
For lngCounter = 0 To UBound(arr) - 1
arr2(lngCounter, 0) = Split(arr(lngCounter), vbTab)(0)
arr2(lngCounter, 1) = Split(arr(lngCounter), vbTab)(1)
arr2(lngCounter, 2) = Split(arr(lngCounter), vbTab)(2)
arr2(lngCounter, 3) = Split(arr(lngCounter), vbTab)(3)
Next
arr2 = ReturnFilteredArray(arr2, "0")
Range("L2").Resize(UBound(arr2, 1), 5) = arr2
Debug.Print Now()
End Sub
There are a number of assumptions in there, not least the dimensions. Note the difference in the second dimension counter between arrDestination and arrSource. That's to do with Excel being 1-based and normal arrays being 0-based.
Also, when I'm writing out the array, I needed to bump up the second dimension to 5 in order to get all of the array out to the sheet. I wasn't able to trim off the empty elements since ReDim Preserve only works on the uppermost dimension (columns) and it's the first dimension (rows) that's changing here.
Anywho, this should serve as a reminder that despite its faults Excel is pretty amazing.
Basically, rather that selecting a range from cells I have stored values in an array through the use of a loop. What I would ideally like to do is use these arrays as the known x's and y's in the LinEst function.
The purpose of this is unimportant as what I am trying to do is only part of the code I have already written. However, the Do loops (well at least the 2nd) do need to be there as the code I am attempting to apply this to requires them in order to function.
Below is a simple example of code I am trying to write.
Sub Test()
Dim Counter As Long
Dim Counter_1 As Long
Dim x As Single
Dim y As Single
Dim i As Single
Dim m As Single
Dim myArray_1() As Single
Dim myArray_2() As Single
ReDim myArray_1(i)
ReDim myArray_2(i)
Counter = 2
Counter_1 = 2
i = 0
Cells(1, 4) = "m"
x = Cells(Counter, 1)
y = Cells(Counter, 2)
Do
Do Until x = 0
myArray_1(i) = x
myArray_2(i) = y
Cells(Counter, 6) = myArray_1(i)
Cells(Counter, 7) = myArray_2(i)
i = i + 1
Counter = Counter + 1
x = Cells(Counter, 1)
y = Cells(Counter, 2)
ReDim Preserve myArray_1(i)
ReDim Preserve myArray_2(i)
Loop
m = WorksheetFunction.LinEst(myArray_2, myArray_1)
Cells(Counter_1, 4) = m
Loop
End Sub
So basically I want the LinEst function to use each array as known y's and known x's. Depending on what I change I get different errors, such as "type mismatch", or "unable to get the LinEst property of the worksheetfunction class". Either way I have so far had no luck in getting this to work and it always errors. From the LinEst function all I want is the gradient 'm'.
The only reason things have been put into cells is to make sure that the code is doing what I ask of it.
From what I can tell looking around the internet it is possible to use an array within the LinEst function, however the examples are usually drastically different to what I am trying to do.
If anyone can help at all I would be most greatful. Thank you in advance. Any questions feel free to ask.
Yes, it can be done. The code snippet below should help get you started:
Dim x() As Variant
ReDim x(1 To 3)
x(1) = 1
x(2) = 2
x(3) = 3
Dim y() As Variant
ReDim y(1 To 3)
y(1) = 4
y(2) = 5
y(3) = 6
Dim z() As Variant
z = WorksheetFunction.LinEst(x, y)
The function returns a Variant which "boxes" an array of Variant (which will be either one- or two-dimensional). The other two parameters (not shown above) are either True or False. The function is otherwise detailed in the Excel Help.
I achieved this with the below code. Hope it helps.
Sub RunLinEst()
Dim vectorX() As Double
Dim vectorY() As Double
Dim theLeastSquareCoef
'you need to define matrix otherwise it doesn't work
ReDim vectorX(0 To 4, 0 To 0)
ReDim vectorY(0 To 4, 0 To 0)
vectorX(0, 0) = 0
vectorX(1, 0) = 1
vectorX(2, 0) = 2
vectorX(3, 0) = 3
vectorX(4, 0) = 4
vectorY(0, 0) = 0
vectorY(1, 0) = 1
vectorY(2, 0) = 4
vectorY(3, 0) = 9
vectorY(4, 0) = 16
theLeastSquareCoef = Application.LinEst(vectorY, Application.Power(vectorX, Array(1, 2)))
Range("F4").Value = Application.Index(theLeastSquareCoef, 1)
Range("F5").Value = Application.Index(theLeastSquareCoef, 2)
Range("F6").Value = Application.Index(theLeastSquareCoef, 3)
End Sub
Here's what I'm trying to do:
Suppose that you have a dynamic array whose dimensions can be from 0x6 up to 10x6 (meaning we can have rows anywhere from 0 to 10, but columns are always 6). I have been desperately trying to create a function (and then bind it to a macro) that will use as argument this first array, and will create a second array as output, whose elements will be the returns of the first array. For example, if we have the simple case of 1x6, then the output array's elements are five and in each case are given by the formula (x_i+1 - x_i)/x_i, i=1, 2, ..., 6. Additionally, the function must be able to bypass any missing values from the input array and ignore the corresponding non-existent return values. The entire thing must be done in VBA script.
It's been two days since I have been searching frantically for some help, but the problem is that I have no idea whatsoever about programming in VBA (I usually use other languages like MATLAB or Mathematica) so this is extremely hard for me. Any solutions that I have found I wasn't able to put together and achieve my goal. Any help is greatly appreciated.
Because you provided no code, I cannot determine exactly what you want to do, but here is an example of passing an array and returning an array that you should be able to extrapolate.
Edit: Just for fun, updated this to work for up to 3 dimensional arrays.
Public Sub Test()
'Defines testArray as Variant 0 to 10
Dim testArray(0 To 1, 0 To 6) As Long
Dim returnArray() As Long
Dim i As Long
Debug.Print UBound(testArray, 2)
'Populates testArray with Longs
For i = 0 To UBound(testArray, 1)
For j = 0 To UBound(testArray, 2)
testArray(i, j) = (i + j) * 2
Next
Next
'Passes testArray and returns ParseArray
returnArray = addOne(testArray)
End Sub
Public Function addOne(arrValues() As Long) As Variant
Dim arrCopy() As Long
Dim dimensionNum As Long, ErrorCheck As Long
On Error Resume Next
For dimensionNum = 1 To 60000
ErrorCheck = LBound(arrValues, dimensionNum)
If Err.Number <> 0 Then
dimensionNum = dimensionNum - 1
Exit For
End If
Next
Dim i As Long, j As Long, k As Long
'Copies passed array to avoid updating passed array directly
arrCopy = arrValues
'Adds 1 to each element of the array.
If dimensionNum = 1 Then
For i = LBound(arrCopy) To UBound(arrCopy)
arrCopy(i) = arrCopy(i) + 1
Next
ElseIf dimensionNum = 2 Then
For i = LBound(arrCopy) To UBound(arrCopy)
For j = LBound(arrCopy, 2) To UBound(arrCopy, 2)
arrCopy(i, j) = arrCopy(i, j) + 1
Next
Next
ElseIf dimensionNum = 3 Then
For i = LBound(arrCopy) To UBound(arrCopy)
For j = LBound(arrCopy, 2) To UBound(arrCopy, 2)
For k = LBound(arrCopy, 3) To UBound(arrCopy, 3)
arrCopy(i, j, k) = arrCopy(i, j, k) + 1
Next
Next
Next
Else
MsgBox "Add function only works for three dimensions or fewer arrays"
End If
addOne = arrCopy
End Function