I have a 1x1 array from the following:
Dim wbottom As Variant
wbottom = WorksheetFunction.MMult(WorksheetFunction.transpose(e), wtop)
I'm trying to get the number in the array. wbottom(0,0) and wbottom(1,1) give "subscript out of range". ReDim-ming gives nothing when I try to print out the number with MsgBox. How do I fix this?
If the resulting matrix is 1x1, the resulting array is 1-dimensional, with the only valid subscript being 1. See below, where A1:E1 and A3:A7 contain values for a 1x5 and 5x1 matrix respectively (so that the multiplication results in a 1x1 matrix):
Sub mmultTest()
Dim v As Variant
v = WorksheetFunction.MMult(Range("A1:E1"), Range("A3:A7"))
Debug.Print LBound(v)
Debug.Print UBound(v)
Debug.Print v(1)
End Sub
The output is as follows:
1
1
55
You could try
wbottom = WorksheetFunction.SumProduct(e, wtop)
Transposing a column into a row and then multiplying it by a column to get a 1x1 matrix gives you a 1x1 matrix whose sole element is the dot-product of the two columns. The function SumProduct is the dot product already, and doesn't require transposing and then unpacking the value.
To test this, I set up a worksheet to look like
A B
------
1 4
2 5
3 6
then ran the following code:
Sub test()
Dim A As Range, B As Range, product As Variant
Set A = Range("A1:A3")
Set B = Range("B1:B3")
With Application.WorksheetFunction
product = .MMult(.Transpose(A), B) 'what you have
Debug.Print TypeName(product)
Debug.Print product(1)
product = .SumProduct(A, B)
Debug.Print TypeName(product)
Debug.Print product
End With
End Sub
with the resulting output:
Variant()
32
Double
32
Related
I am trying to copy a few non-contiguous columns (say Column A, Column C, Column E) into a dynamic array. However, it appears that only contiguous ranges were copied, leaving the non-contiguous ranges, when using the VBA Application.Union method.
I have tried copying contiguous columns (A, B, C, D, E), which worked as expected, but non-contiguous columns (A, C, E) doesn't.
Can anyone assist me on this? Thanks.
Sub TestFunction()
Dim TempArray() As Variant
Dim rngUnion As Range
With ThisWorkbook.Worksheets(2)
Set rngUnion = Application.Union(.Range("A1:A10"), .Range("C1:C10"), .Range("E1:E10"))
End With
TempArray = rngUnion
End Sub
Tim Williams already answered your question. I just wanted to demonstrate a cool way to create an array from multiple non-contiguous ranges. The key to this working is that all the ranges have 1 column and the same number of rows.
getArrayFromRanges takes the array of values from each range passed to it and converts it from a 2D array to an 1D array using Transpose. Each one of these 1D Temp arrays are added to the 1D Data array. Transpose is then used to convert the Data from an 1D Array od 1D arrays into a 2D array.
Sub TestFunction()
Dim Data
With Worksheets(2)
Data = getArrayFromRanges(.Range("A1:A10"), .Range("C1:C10"), .Range("E1:E10"))
.Range("A12").Resize(UBound(Data, 1), UBound(Data, 2)) = Data
End With
End Sub
Function getArrayFromRanges(ParamArray Sources())
Dim Data, Temp, v
Dim x As Long
ReDim Data(UBound(Sources))
For Each v In Sources
Temp = Application.Transpose(v)
Data(x) = Temp
x = x + 1
Next
getArrayFromRanges = Application.Transpose(Data)
End Function
Sample Data from Contextures Excel Sample Data
You didn't mention what you are doing with the array, so I'm not sure if this will work for you. But, instead of the array, why not use rngUnion directly, and loop through its Areas collection as needed?
For example, this function:
Sub TestFunction2()
Dim rngUnion As Range
Dim area As Range
With ThisWorkbook.Worksheets(2)
Set rngUnion = Application.Union(.Range("A1:A10"), .Range("C1:C10"), .Range("E1:E10"))
End With
For Each area In rngUnion.Areas
Debug.Print area.Address
Next area
Set area = Nothing
Set rngUnion = Nothing
End Sub
Returns this output:
$A$1:$A$10
$C$1:$C$10
$E$1:$E$10
If you really do need the array, you could just use the same loop to add the individual Areas (i.e. Ranges) to the array.
Situation
I have a UDF that works with a range that it is passed that is of variable height and 2 columns wide. The first row will contain text in column 1 and an empty column2. The remainder of column 1 will contain unsorted text with an associated value in the same row in column 2. I need to sort the data such that if some text in column 1 also appears in some other text in column.
Problem
My VBA skills are all self taught and mimimal at best. I remember a few decades ago in university we did bubble sorts and played with pointers, but I no longer remember how we achieved any of that. I do well reading code but creating is another story.
Objective
I need to generate a sort procedure that will produce unique text towards the bottom of the list. I'll try wording this another way. If text in column1 can be found within other text in column, that the original text need to be placed below the other text it can be found in along with its associated data in column 2. The text is case sensitive. Its not an ascending or descending sort.
I am not sure if its a restriction of the UDF or not, but the list does not need to be written back to excel, it just needs to be available for use in my UDF.
What I have
Public Function myFunk(rng As Range) As Variant
Dim x As Integer
Dim Datarange As Variant
Dim Equation As String
Dim VariablesLength As Integer
Dim Variable As String
Datarange = rng.Value
'insert something around here to get the list "rng or Datarange" sorted
'maybe up or down a line of code depending on how its being done.
Equation = Datarange(1, 1)
For x = 2 To UBound(Datarange, 1)
VariablesLength = Len(Datarange(x, 1)) - 1
Variable = Left$(Datarange(x, 1), VariablesLength)
Equation = Replace$(Equation, Variable, Datarange(x, 2))
Next x
myFunk = rng.Worksheet.Evaluate(Equation)
End Function
Example Data
Any help with this would be much appreciated. In that last example I should point out that the "=" is not part of the sort. I have a routine that strips that off the end of the string.
So in order to achieve what I was looking for I added a SWAP procedure and changed my code to look like this.
Public Function MyFunk(rng As Range) As Variant
Dim x As Integer
Dim y As Integer
Dim z As Integer
Dim datarange As Variant
Dim Equation As String
Dim VariablesLength As Integer
Dim Variable As String
'convert the selected range into an array
datarange = rng.Value
'verify selected range is of right shape/size
If UBound(datarange, 1) < 3 Or UBound(datarange, 2) <> 2 Then
MyFunk = CVErr(xlErrNA)
Exit Function
End If
'strip the equal sign off the end if its there
For x = 2 To UBound(datarange, 1)
If Right$(datarange(x, 1), 1) = "=" Then
datarange(x, 1) = Left$(datarange(x, 1), Len(datarange(x, 1)) - 1)
End If
Next x
'sort the array so that a variable does not get substituted into another variable
'do a top down swap and repeat? Could have sorted by length apparently.
For x = 2 To UBound(datarange, 1) - 1
For y = x + 1 To UBound(datarange, 1)
If InStr(1, datarange(y, 1), datarange(x, 1)) <> 0 Then
For z = LBound(datarange, 2) To UBound(datarange, 2)
Call swap(datarange(y, z), datarange(x, z))
Next z
y = UBound(datarange, 1)
x = x - 1
End If
Next y
Next x
'Set the Equation
Equation = datarange(1, 1)
'Replace the variables in the equation with values
For x = 2 To UBound(datarange, 1)
Equation = Replace$(Equation, datarange(x, 1), datarange(x, 2))
Next x
'rest of function here
End Function
Public Sub swap(A As Variant, B As Variant)
Dim Temp As Variant
Temp = A
A = B
B = Temp
End Sub
I sorted by checking to see if text would substitute into other text in the list. Byron Wall made a good point that I could have sorted based on text length. Since I had completed this before I saw the suggestion it did not get implemented though I think it may have been a simpler approach.
I have a 2D array and I am trying to add along one dimension. The 2D Array is of type variant and might have some of the elements as null ("")
Here is the code so far
'newArray is 2D Array
Function SumColumn(newArray As Variant, index As Integer) As Double
Dim tempArray() As Double
ReDim tempArray(1 To UBound(newArray))
For i = 1 To (UBound(newArray))
tempArray(i) = CDbl(newArray(i, index))
Next
SumColumn = Application.WorksheetFunction.Sum(tempArray)
End Function
I get a type mismatch error when I am running the above code. Please help me debug
You are probabaly getting a Type mismatch because CDbl(newArray(i, index)) might actually not be a number.
This works for me. Please amend the code to suit your needs.
For demonstration purpose, I am storing an Excel range into a 2D array and then converting it to a 1D temp array. Once that is done, I am simply storing the relevant Numbers in the Double Array and finally calculating the sum.
Lets say that the worksheet looks like this
Option Explicit
Sub Sample()
Dim MyAr, TempAr()
Dim dAr() As Double
Dim n As Long, i As Long
MyAr = ActiveSheet.Range("A1:A10").Value
TempAr = Application.Transpose(MyAr)
ReDim dAr(0 To 0)
n = 0
For i = LBound(TempAr) To UBound(TempAr)
If Len(Trim(TempAr(i))) <> 0 Then
If IsNumeric(Trim(TempAr(i))) Then
ReDim Preserve dAr(0 To n)
dAr(UBound(dAr)) = Trim(TempAr(i))
n = n + 1
End If
End If
Next i
Debug.Print Application.WorksheetFunction.Sum(dAr)
End Sub
And this is the output
I have a two dimensional table in Excel. eg.
outputproduct blending combination
**5 P1:0.6/P3:0.5**
2 P1:0.3/P2:0.7
4 P5:0.4/P2:0.7
7 P11:0.7/P7:0.4
Suppose the range of the table varies from B2:C6 (it can vary). I have to create a function, whose first job is to read this range( which would be a user defined input) and then stores the data into a 2 dimensional array such that I could use the data(integer) in the first column and the string in the second column, appropriately.
The first column is the resultant product index, while the second column is the blending products in the given ratio, which combine together to give the product in the first column.
Then there is another table:
product index current stock updated stock
**1** **10**
2 20
**3** **50**
4 15
**5** **100**
. .
. .
. .
I have to update the stock amount in this table after the data processing.
For example, on combination of product 1 with product 3 in the ratio of 6:5 (units), 1 unit of product 5 is produced. So, I have to update the amount of stock for each of the products in table 2.
Any suggestions, how to convert the range into a 2 dimensional array?
Public Function Blending_function( R1 as Range, R2 as Range)
' R2 is the range of table 2, where the updating is to be done
' R1 is first stored in to a 2 dimensional array, such that the data in the
' column 1 could be read, and the data in the column 2 could be read (of table 1).
' the integer in the column 1 of table 1 refers to the product index in table 2.
' P(i) stands for the ith product. In first row of table-1, P1 and P3 combine in the
' ratio of 6:5 to give P5. The current stock of each product is provide in table-2,
' whose range is R2(entire table 2).
' R1 is the range of table 1, from where the processing is to be done
End Function
The main hurdle for me is to convert the range R1 (Table-1) into a 2 dimensional array. And then look from that array, the index of the output product, and locate that product in table-2 for updating the stock level.
Here is an example on how to work with 2D array. The function will break up the blending combination and extract the values that you want so that you can use those.
Sub Sample()
Dim Rng1 As Range, Rng2 As Range
On Error Resume Next
Set Rng1 = Application.InputBox("Please select the Table1 Range", Type:=8)
On Error GoTo 0
If Rng1.Columns.Count <> 2 Then
MsgBox "Please select a range which is 2 columns wide"
Exit Sub
End If
On Error Resume Next
Set Rng2 = Application.InputBox("Please select the Table2 Range", Type:=8)
On Error GoTo 0
If Rng2.Columns.Count <> 3 Then
MsgBox "Please select a range which is 3 columns wide"
Exit Sub
End If
Blending_function Rng1, Rng2
End Sub
Public Function Blending_function(R1 As Range, R2 As Range)
Dim MyAr1 As Variant, MyAr2 As Variant
Dim i As Long
Dim blndCom As String, OutputPrd As String
Dim ArP1() As String, ArP2() As String, tmpAr() As String
MyAr1 = R1
For i = 2 To UBound(MyAr1, 1)
OutputPrd = MyAr1(i, 1)
blndCom = MyAr1(i, 2)
tmpAr = Split(blndCom, "/")
ArP1 = Split(tmpAr(0), ":")
ArP2 = Split(tmpAr(1), ":")
Debug.Print OutputPrd
Debug.Print Trim(ArP1(0))
Debug.Print ArP1(1)
Debug.Print ArP2(0)
Debug.Print ArP2(1)
Debug.Print "-------"
Next
End Function
SNAPSHOT
Once you have these values you can use .Find to search for the product index in the range R2 and then use .Offset to enter your formula.
I'm not sure if I understood the entire story, but this is what a function to return
a multidimensional array could look like:
Public Sub Main_Sub()
Dim vArray_R1() As Variant
Dim oRange As Range
Set oRange = ThisWorkbook.Sheets(1).Range("A1:B5")
vArray_R1 = Blending_function(oRange)
'You do the same for The second array.
set oRange = nothing
End Sub
Public Function Blending_function(R1 As Range)
Dim iRange_Cols As Integer
Dim iRange_Rows As Integer
iRange_Cols = R1.Columns.Count
iRange_Rows = R1.Rows.Count
'Set size of the array (an existing array would be cleared)
ReDim vArray(1 To iRange_Rows, 1 To iRange_Cols)
vArray = R1
Blending_function = vArray
End Function
A second option could be to declare the function to return a boolean and since arguments are standard sent byRef; you can declare the ranges and arrays in the main sub only, and convert them both at the same time in the function. I wouldn't choose for this option, because you wouldn't be able to re-use the function afterwards to convert other ranges into arrays.
Supplementary info:
This technique works both ways. You can afterwards define a range and do:
set oRange = vArray
This on the condition that the Range has the same size as the array.
row = 2
column = "B"
Do While Len(Range(column & row).Formula) > 0
' repeat until first empty cell in column 'column'(user input)
' read (column, row) and (column+1, row) value
Cells(row, column).Value
Cells(row, column+1).value
' store in Array
Loop
How do I write a VBA Macro that would take the power of a matrix (to an arbitrary user-specified power) that is located in cells A1 to C3?
Taking your question literally in the mathematical sense, this macro raises the matrix to a power (4 in the example) by repeatedly calling Excel's MMULT function.
Dim i As Long
Dim pow As Long
Dim vIn As Variant
Dim vOut As Variant
pow = 4 ' or whatever
' Fetch matrix from sheet
vIn = Range("A1:C3")
' Raise to power
vOut = vIn
For i = 1 To pow - 1
vOut = WorksheetFunction.MMult(vOut, vIn)
Next i
' Write result to sheet
Range("E1:G3") = vOut
I used the function below. Please note that, when the exponent is 0, the function returns the identity matrix, otherwise the matrix multiplied by itself the exponent number of times.
'Raises matrix to a power
Function PowerMatrixNew(rngInp As Range, lngPow As Integer) As Variant()
'create identitu for power 0
Dim identity() As Variant
ReDim identity(rngInp.Rows.Count, rngInp.Rows.Count)
Dim i As Integer
Dim j As Integer
For i = 1 To rngInp.Rows.Count
For j = 1 To rngInp.Rows.Count
If (i = j) Then
identity(i, j) = 1
Else
identity(i, j) = 0
End If
Next j
Next i
PowerMatrixNew = identity
For i = 1 To lngPow
PowerMatrixNew = Application.WorksheetFunction.MMult(rngInp, PowerMatrixNew)
Next
End Function
There was a question like this some years ago which I remember because it was called matrix arithmetic but not as I was taught at school.
Fill cells A1:C3 with the numbers 1 to 9. Set cell A5 to 2. Select cells A7:C9 and type
=power(A1:C3,A5) ctrl+shift+enter
and cells A7:C9 will be set to the squares of the values in A1:C3. Change A5 to 3 and cells A7:C9 will be set to the cubes of the values in A1:C3.
The equivalent in VBA is:
Range("a7:c9").FormulaArray = "=Power(a1:c3, a5)"