I am writing a function that adds or multiplies all values in a chosen row in an array by number (x). But in the part
If method = 1 Then
rng.Rows(row_number) = rng.Rows(row_number) * x
ElseIf method = 2 Then
rng.Rows(row_number) = rng.Rows(row_number) + x
End If
I get the error message "Run time error 424; object required".
Besides this code, I tried to use .Select or .entirerow.select, but none of them worked.
Function shiftMatrix(rg As Range, row_number As Long, x As Double, method As Integer) As Variant
Dim rng As Variant
rng = rg.value
If method = 1 Then
rng.Rows(row_number) = rng.Rows(row_number) * x
ElseIf method = 2 Then
rng.Rows(row_number) = rng.Rows(row_number) + x
End If
shiftMatrix = rng
End Function
Sub try() '
Dim rng As Variant
With Worksheets("Macro1")
rng = shiftMatrix(Worksheets("Macro1").Range("A12:AX14"), 3, 0.5, 1)
End With
End Sub
Ideally, this function would display an array "rng" in Locals, such that rng(1) and rng(2) would remain unchanged and rng(3) would be added or multiplied by "x".
See if this helps
Option Explicit
Function shiftMatrix(rg As Range, row_number As Long, x As Double, method As Long) As Variant
Dim rng As Variant
Dim i As Long
rng = rg.value
If method = 1 Then
For i = 1 To UBound(rng, 2)
If IsNumeric(rng(row_number, i)) Then rng(row_number, i) = rng(row_number, i) * x
Next i
ElseIf method = 2 Then
For i = 1 To UBound(rng, 2)
If IsNumeric(rng(row_number, i)) Then rng(row_number, i) = rng(row_number, i) + x
Next i
End If
shiftMatrix = rng
End Function
rng is a two-dimensional array that holds the information from your rg range variable.
I have created a loop that goes through the specified record (row) in that array and updates (either multiplies or adds) those values. Once that loop is completed, you return the array to the shiftMatrix array and after that you can just fill a range with that array again.
Two-dimensional arrays constructed from ranges are base 1, whereas the standard for regular arrays is base 0.
In your code, you treated the array as if it was still a range object. It's quicker to edit a range en masse in an array and later parse that information back into the range, rather than editing the Excel range directly.
Related
I have three UDF's:
Private Function IsInArray(stringToBeFound As Variant, arr As Variant) As Boolean
IsInArray = Not IsError(Application.Match(stringToBeFound, arr, 0))
End Function
This function checks if something is in the array.
Private Function data_to_array(data As Range)
Dim arrArray As Variant
Dim cell As Range
Dim z As Integer
z = 0
ReDim arrArray(1 To data.Cells.Count)
For Each cell In data
z = z + 1
arrArray(z) = cell.Value
Next cell
data_to_array = arrArray
End Function
This function extracts selected range values and puts them into an array.
Private Function plot_vals(data As Variant, custom_arr As Variant)
Dim arrPlot As Variant
ReDim arrPlot(1 To UBound(data)) As Variant
Dim c As Integer
Dim cl As Integer
cl = 0
For c = 1 To UBound(data)
cl = cl + 1
If IsInArray(cl, custom_arr) Then
arrPlot(cl) = data(cl)
Else
arrPlot(cl) = CVErr(xlErrNA)
End If
Next c
plot_vals = arrPlot
End Function
The last UDF loops through the data array from second UDF and if index/position of value in data_array is in custom_array, then it returns its value. Otherwise it puts an error into an array.
Data looks like this:
These functions are used like this in Excel:
data_to_array(A1:A5) - this UDF creates an array(1 to 5) with values from cells A1:A5.
plot_vals(data_to_array(A1:A5), {1,5}) - this UDF creates an array(1 to 5), and uses second argument to retrieve first and fifth values while putting errors in the other indexes. The result is array of for example: {5,error,error,error,1}
If I used the function on above data like this: plot_vals(data_to_array(A1:A5), {1,2}) then the result would be an array {5,4,error,error,error}
That plot_vals UDF is used in named range and that named range is used to plot values on chart.
Data is stored in named range myData and the function in second named range is used like this:
plot_vals(myData,{1,5}).
Everything works, I can plot it on chart, all is good but when the named ranges are used on charts, every time I change something in my workbook all functions are recalculated like... 10 times each one, instead of once. It causes Excel to slow down/freeze if those functions are used many times. I have tried to search about function volatility and how to turn it off (it should be turned off by default?), but nothing seems to be working and I do not know how to stop that from happening. I have tried to recreate this in Excel using standard Excel functions in named ranges, but I cannot find a correct function to do what I want. UDF is exactly what I need.
When these named ranges are NOT used in charts then nothing happens, but as soon as I use the named range on chart then it recalculates everything on even a minor change of a workbook. Minor change meaning - copying / pasting / adding rows etc.
How can I stop that from happening? How to recalculate UDF's only once?
EDIT on further research:
I have tried the potential solutions provided by Charles Williams:
https://fastexcel.wordpress.com/2011/11/25/writing-efficient-vba-udfs-part-7-udfs-calculated-multiple-times/
His potential solutions do not change anything.
I have also tried using Sheet_Change event, changing calculations to manual and then back to automatic. It helps but it clears the clipboard (unacceptable) and it causes issues with my other macros, so it is a "no-go" solution.
It is also worth noting, that as soon as the chart is deleted and the UDF's remain in named ranges, everything is working nice and smooth. But when those named ranges are in chart series formulas, everything is recalculating 100's of times.
Aside from trying to fix the basic problem of how many times your functions get called, you can partially address the slow-down by optimizing the basic performance:
Application.Match is relatively slow unless the data being searched in on a worksheet
Reading a range into an array is slower than reading the whole range at once using its .Value (assuming range is a single area)
So:
Sub PerfTester()
Const ARR_SZ As Long = 10
Dim arr(1 To ARR_SZ), i, n, t, v, m
'populate a test array
For i = 1 To ARR_SZ
arr(i) = i
Next i
t = Timer
For n = 1 To 100000
v = Round(Rnd * ARR_SZ, 0)
m = IsInArray(v, arr) 'using match
Next n
Debug.Print Timer - t '~ 1.7 sec
t = Timer
For n = 1 To 100000
v = Round(Rnd * ARR_SZ, 0)
m = IsInArray2(v, arr) 'using a loop
Next n
Debug.Print Timer - t '~0.11 sec
t = Timer
For n = 1 To 100000
v = data_to_array(Range("A1:A50")) 'using cell-by-cell
Next n
Debug.Print Timer - t '~ 11.5 sec
t = Timer
For n = 1 To 100000
v = data_to_array2(Range("A1:A50")) 'using single read from range
Next n
Debug.Print Timer - t '~ 2.8 sec
End Sub
Private Function IsInArray(stringToBeFound As Variant, arr As Variant) As Boolean
IsInArray = Not IsError(Application.Match(stringToBeFound, arr, 0))
End Function
Private Function IsInArray2(stringToBeFound As Variant, arr As Variant) As Boolean
Dim i
For i = LBound(arr) To UBound(arr)
If arr(i) = stringToBeFound Then
IsInArray2 = True
Exit For
End If
Next i
End Function
Private Function data_to_array(data As Range)
Dim arrArray As Variant, cell As Range, z As Integer
z = 0
ReDim arrArray(1 To data.Cells.Count)
For Each cell In data
z = z + 1
arrArray(z) = cell.Value
Next cell
data_to_array = arrArray
End Function
Private Function data_to_array2(data As Range)
Dim arrArray As Variant, cell As Range, z As Long, v
v = data.Value
ReDim arrArray(1 To UBound(v, 1))
For z = 1 To UBound(v, 1)
arrArray = v(z, 1)
Next z
data_to_array2 = arrArray
End Function
You should be able to prevent unnecessary additional calculations by including
Application.EnableEvent = False
Application.Calculation = xlManual
at the start of your functions and
Application.EnableEvents = True
Application.Calculation = xlAutomatic
at the end of your functions. This prevents your spreadsheet from attempting to update and recalculate whenever you make a minor change. If you feel it necessary, you can add
Worksheet.Calculate
at some point in your code to force a recalculation of the current sheet.
I've working with three dynamic arrays (all are datatype Double) - they are
OriningalArray
This will be assigned from a range that the end user will see and will be 2 dimension
MultiplierArray
This will be multipliers as (most of which will be 1 but some will be between +-5% and will always be same length as one of the dimensions in OriningalArray.
NewArray
This is required as there will be certain discounts that will need to be applied to the OriningalArray and both dimension will be the same size as it.
Here's a sample for a visual reference:
I have code that works (below) and have commented it also to explain why I'm doing it that way (this is just an example and actual data size will be much bigger) but was hoping someone could tell me how to optimize it further:
Sub Test()
Dim OriningalArray() As Double ' I can't declare it a Variant and then assign it straight from the range (OriningalArray = Rng) because there may be "N/A" values in the range which, when put into an Variant Array, gives false Double value
Dim MultiplierArray() As Variant
Dim NewArray() As Double
Dim Rng As Range
Dim MultiplierRng As Range
Dim x As Long, y As Long
Set Rng = Range("D4:I9")
Set MultiplierRng = Range("D12:I12")
ReDim OriningalArray(1 To Rng.Rows.Count, 1 To Rng.Columns.Count) ' 2D Array the sze of the range
ReDim NewArray(1 To Rng.Rows.Count, 1 To Rng.Columns.Count) ' 2D Array the sze of the range
MultiplierArray = MultiplierRng
On Error Resume Next ' Turn off error handler to stop macro crashing when trying to assign "N/A" as a Double
For x = 1 To Rng.Columns.Count
For y = 1 To Rng.Rows.Count
OriningalArray(y, x) = Rng.Cells(y, x).Value
NewArray(y, x) = OriningalArray(y, x) * MultiplierRng(1, x)
'Debug.Print OriningalArray(y, x)
'Debug.Print NewArray(y, x)
Next y
Next x
On Error GoTo 0
End Sub
Quicker to load the arrays in one hit:
OriningalArray = Range("D4:I9").Value2
and then loop through the arrays doing the multiplication. Or just use Evaluate to calculate the arrays in the first place:
Dim NewArray
NewArray = Activesheet.Evaluate("D4:I9*D12:I12")
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 need a function to extract 2 dimensions from a multidimesion array. which 2 dimensions to extract depending on the choise of the user. and the index in the discarded dimensions where those 2 dimensions are picked also depending on the user.
For example, i have a 3 dimension array v(1 to 100, 1 to 20, 1 to 10). i would like to extrat dimension 1 and dimension 3 from v. and the index in the discared dimension 2 is 11.
sub extract
dim i1 as integer 'for loop through dimension 1
dim i2 as integer 'for loop through dimension 3
dim d1 as integer 'index in dimension 2
d1=11
redim vn(1 to ubound(v,1),1 to ubound (v,3))
for i1 = 1 to ubound(v,1)
for i2= 1 to ubound(v,3)
vn(i1,i2)=v(i1,d1,i2)
next i2
next i1
end sub
I can extract dimensions from array, if i know which dimensions i need and the index (d1) in the discarded dimensions. however, i need to leave that to the users to decide. what i want is a function like that:
function extract(i1 as integer, i2 as intger, paramarray ov()) as variant
=extract(the_first_dimension_to_keep,the_second_dimension_to_keep,[index_in_the_first_discard_dimension,index_in_the_second_discard_dimension,...])
Keeping in mind that the origional array can have more than 3 dimensions, so list all the possibility in the code is not possible.
Any solution?
The quickest way would be to read the array with a pointer and increment the pointer value by an algorithmic value based on the number of dimensions and number of elements in each. This site has an excellent tutorial on managing pointers to arrays: http://bytecomb.com/vba-internals-getting-pointers. However, it'd be one mighty coding task - just dimensioning the rgabounds of your SAFEARRAY for the memory read would be a task - and if your array values were Strings, it'd be of an order of magnitude mightier.
An easier, though doubtless slower, option would be to exploit the For Each looping method, which can be applied to an array. Its looping sequence is like so:
arr(1,1)
arr(2,1)
arr(3,1)
arr(1,2)
arr(2,2)
arr(3,2)
etc.
So you'd only need a simple odometer-style index counter.
You could basically iterate every element in the array and if the combination of indexes matched what you wanted, you'd read the element into your extraction array. That would be a much easier task. The code below shows you how you could do this on a multi-dimensional array of unknown dimensions.
Option Explicit
Private Type ArrayBounds
Lower As Long
Upper As Long
Index As Long
WantedDimension As Boolean
DiscardIndex As Long
End Type
Public Sub RunMe()
Dim arr As Variant
Dim result As Variant
arr = CreateDummyArray
result = Extract(arr, 1, 3, 11)
End Sub
Private Function Extract(arr As Variant, i1 As Integer, i2 As Integer, ParamArray ov() As Variant) As Variant
Dim d As Long
Dim bounds() As ArrayBounds
Dim i As Long
Dim v As Variant
Dim ovIndex As Long
Dim doExtract As Boolean
Dim result() As Variant
'Dimension the output array
ReDim result(LBound(arr, i1) To UBound(arr, i1), LBound(arr, i2) To UBound(arr, i2))
'Get no. of dimensions in array
d = GetDimension(arr)
'Now we know the number of dimensions,
'we can check that the passed parameters are correct
If (i1 < 1 Or i1 > d) Or (i2 < 1 Or i2 > d) Then
MsgBox "i1/i2 - out of range"
Exit Function
End If
If UBound(ov) - LBound(ov) + 1 <> d - 2 Then
MsgBox "ov - wrong number of args"
Exit Function
End If
'Resise and populate the bounds type array
ReDim bounds(1 To d)
ovIndex = LBound(ov)
For i = 1 To d
With bounds(i)
.Lower = LBound(arr, i)
.Upper = UBound(arr, i)
.Index = .Lower
.WantedDimension = (i = i1) Or (i = i2)
If Not .WantedDimension Then
.DiscardIndex = ov(ovIndex)
ovIndex = ovIndex + 1
'Check index is in range
If .DiscardIndex < .Lower Or .DiscardIndex > .Upper Then
MsgBox "ov - out of range"
Exit Function
End If
End If
End With
Next
'Iterate each member of the multi-dimensional array with a For Each
For Each v In arr
'Check if this combination of indexes is wanted for extract
doExtract = True
For i = 1 To d
With bounds(i)
If Not .WantedDimension And .Index <> .DiscardIndex Then
doExtract = False
Exit For
End If
End With
Next
'Write value into output array
If doExtract Then
result(bounds(i1).Index, bounds(i2).Index) = v
End If
'Increment the dimension index
For i = 1 To d
With bounds(i)
.Index = .Index + 1
If .Index > .Upper Then .Index = .Lower Else Exit For
End With
Next
Next
Extract = result
End Function
Private Function GetDimension(arr As Variant) As Long
'Helper function to obtain number of dimensions
Dim i As Long
Dim test As Long
On Error GoTo GotIt
For i = 1 To 60000
test = LBound(arr, i)
Next
Exit Function
GotIt:
GetDimension = i - 1
End Function
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