I tried putting the program into VBA, but I keep getting an error. This line was highlighted:
B(i, j) = C(i, j) + A(i + 1, j) * A(i, j + 1)
I am trying to multiply two of the same matrices and then add it to itself.
Suppose I wanted to multiply a 15 x 15 matrix, would I use the same codes except just change the dimensions and ranges?
Sub testing()
Dim A As Variant
Dim B(1 To 2, 1 To 2)
Dim C(1 To 2, 1 To 2)
A = Range("A1:B2").Value
i = 1
C(1, 1) = 0
Do Until i = 3
j = 1
Do Until j = 3
C(i, j) = C(i, j) + A(i, j) * A(j, i)
**B(i, j) = C(i, j) + A(i + 1, j) * A(i, j + 1)**
j = j + 1
Loop
i = i + 1
Loop
Range("E1:F2").Value = B
End Sub
Thanks!
Do...Loop is not the right tool for this job. Use For...Next instead. Also, to help make sure you don't overrun the array bounds and get a subscript out of range error, you can use LBound and UBound instead of hard-coding the index bounds. That way you don't have to change the code if you change the size of your input matrix.
This will get you part of the way. For simplicity I assumed A is a square matrix.
Dim i As Long, j As Long
Dim A As Variant
Dim B() As Variant
Dim C() As Variant
A = Range("A1:B2").Value
ReDim B(LBound(A, 1) To UBound(A, 1), LBound(A, 2) To UBound(A, 2))
ReDim C(LBound(A, 1) To UBound(A, 1), LBound(A, 2) To UBound(A, 2))
For i = LBound(A, 1) To UBound(A, 1)
For j = LBound(A, 2) To UBound(A, 2)
C(i, j) = C(i, j) + A(i, j) * A(j, i)
B(i, j) = C(i, j) + A(i + 1, j) * A(i, j + 1) ' still bad
Next j
Next i
Now you'll still get an error on that same line, due to the i+1 and j+1 indices. Those will have a value of 3 at some point, which is beyond your array bounds of 2. I can't help you fix that line, because I don't understand what you are trying to do with it.
Which brings me to my next point: if you think you're doing a matrix multiplication with this line
C(i, j) = C(i, j) + A(i, j) * A(j, i)
then you are wrong. The correct definition is:
and this is not what you have implemented.
A perhaps more convenient way to do it is to use the built-in MMult function:
C = WorksheetFunction.MMult(A, A)
Related
With some 20K observations, the following code takes some 7.5 sec to run
'Remember time when macro starts
StartTime = Timer
For i = 2 To UBound(avTransposed, 2)
For J = 1 To UBound(avTransposed, 1)
k = IIf(J = 1, k + 1, k)
' If J = 1 Then k = k + 1
ReDim Preserve TrueUsedRangeArray(1 To Dim2, 1 To k)
TrueUsedRangeArray(J, k) = avTransposed(J, i)
Next
Next
'Determine how many seconds code took to run
SecondsElapsed = Round(Timer - StartTime, 2)
Without the
k = IIf(J = 1, k + 1, k) line (or If J = 1 Then k = k + 1), it takes less than one sec!!
Any idea?
The ReDim Preserve is probably killing performance. Every time it is used, it creates a new array and copies the existing array in.
You can work out up-front the size of TrueUsedRangeArray, something like the following
ReDim TrueUsedRangeArray(1 To Ubound(avTransposed, 2), 1 To Ubound(avTransposed, 1))
Too many things in your inner loop which do not need to be there:
For i = 2 To UBound(avTransposed, 2)
k = k + 1
ReDim Preserve TrueUsedRangeArray(1 To Dim2, 1 To k)
For J = 1 To UBound(avTransposed, 1)
TrueUsedRangeArray(J, k) = avTransposed(J, i)
Next
Next
As Patrick notes though, you do not need the redim preserve in the loop, since you already know the final size of TrueUsedRangeArray from the dimensions of avTransposed
Why do I get "Subscript out of range" on my line T(k) = Cells(k + 1, 4).Value - z?
Public Sub find()
Dim i, j, k, h As Integer
Dim T() As Double
Dim z As Double
Range("E1").Activate
i = ActiveCell.Row
j = ActiveCell.Column
While Not IsEmpty(Cells(i, j - 2).Value)
z = Cells(i, j - 2).Value
k = 0
While Not IsEmpty(Cells(k + 1, 4).Value)
T(k) = Cells(k + 1, 4).Value - z
k = k + 1
Wend
For h = 0 To k
If T(h) = Application.WorksheetFunction.Min(Abs(T(k))) Then
Cells(i, j).Value = Cells(h + 1, 4).Value
End If
Next
i = i + 1
Wend
End Sub
At the point where you say T(k) = ..., your array T hasn't been allocated yet. There isn't any such thing as T(0) yet. Hence the "Subscript out of range" error.
Before indexing into T, you have to give T a size using ReDim. For example:
Dim T() As Double
ReDim T(0 to 123) ' or whatever size you need
I have this bit of my code which takes like 90 % of the runtime.
There are about 8000 rows and information are stored in column A. This bit of code is splitting this information in the other columns.
It takes approximately 15 mins to run ( :O ).
Any suggestions on how to improve the performance ?
For i = 2 To Row_Number ' Loop for each row
If InStr(Cells(i, 1), "//") = 0 Then ' This means that if // appears somewhere in the text we delete all the rows (including this one) (see Else :) and stop the loop
j = 1
Do Until Mid(Cells(i, 1), j, 1) = ";"
j = j + 1
Loop
LongVIN = Mid(Cells(i, 1), 1, j - 1)
k = j
j = j + 1
Do Until Mid(Cells(i, 1), j, 1) = ";"
j = j + 1
Loop
Cells(i, 3) = Mid(Cells(i, 1), k + 1, j - k - 1) ' Model
k = j
j = j + 1
Do Until Mid(Cells(i, 1), j, 1) = ";"
j = j + 1
Loop
Cells(i, 4) = Mid(Cells(i, 1), k + 1, j - k - 1) ' Dealer
k = j
j = j + 1
Do Until Mid(Cells(i, 1), j, 1) = ";"
j = j + 1
Loop
k = j
j = j + 1
Do Until Mid(Cells(i, 1), j, 1) = ";"
j = j + 1
Loop
Cells(i, 6) = Mid(Cells(i, 1), k + 1, j - k - 1) ' Region
k = j
j = j + 1
Do Until Mid(Cells(i, 1), j, 1) = ";"
j = j + 1
Loop
Cells(i, 7) = CDate(Mid(Cells(i, 1), k + 1, j - k - 1)) ' Retail Date
k = j
Cells(i, 5) = Mid(Cells(i, 1), k + 1, Len(Cells(i, 1)) - k) '(Len - (k+1) +1) Dealer Name
Cells(i, 1) = Mid(LongVIN, 1, 10)
Cells(i, 2) = Mid(LongVIN, 11, 7)
Else:
Range("A" & i & ":A" & Row_Number).Delete 'ClearContents
Exit For
End If
Next i
You should see a significant boost in performance by storing the data in an array, operating on the array, and storing the data back into the spreadsheet.
Something like:
Dim data As Variant
Dim result As Variant
data = Range(Cells(2, 1), Cells(Row_Number, 1))
Redim result (1 To Row_Number, 1 To 7) As Variant
Now instead of reading from Cells(i, 1), you read from data(i, 1) and instead of writing to Cells(i, n) you write to result(i, n).
And at the end of your code:
Range(Cells(2, 1), Cells(Row_Number, 7)) = result
I am manually transposing a large array from a recordset (.transpose did not work) but the first column is missing. Can anyone tell me where I went wrong
Dim FinalArr As Variant
ReDim FinalArr(1 To UBound(ArrRs1, 2), 1 To UBound(ArrRs1, 1))
For i = 1 To UBound(ArrRs1, 2)
For j = 1 To UBound(ArrRs1, 1)
FinalArr(i, j) = ArrRs1(j, i)
Next
Next
The array had a lower bound of 0.
Dim PasteArray As Variant
ReDim PasteArray(1 To UBound(ArrRs1, 2), 0 To UBound(ArrRs1, 1))
For i = 1 To UBound(ArrRs1, 2)
For j = 0 To UBound(ArrRs1, 1)
PasteArray(i, j) = ArrRs1(j, i)
Next
Next
I am trying to write a general code for matrix multiplication but when I am trying to verify it, the output is always a null matrix. So it seems that the values of the temp matrix are not getting updated.
Please suggest some changes for it to work. The code is copied below:
Public Function matrixmultiply(x() As Double, y() As Double) As Double()
Dim nrow1 As Integer, nrow2 As Integer, ncol1 As Integer, ncol2 As Integer, i As Integer, j As Integer, k As Integer, temp() As Double
nrow1 = UBound(x, 1) - LBound(x, 1) + 1
ncol1 = UBound(x, 2) - LBound(x, 2) + 1
nrow2 = UBound(y, 1) - LBound(y, 1) + 1
ncol2 = UBound(y, 2) - LBound(y, 2) + 1
ReDim matrixmultiply(1 To nrow1, 1 To ncol2)
ReDim temp(1 To nrow1, 1 To ncol2)
For i = 1 To nrow1
For j = 1 To ncol2
d = 2
For k = 1 To col1
temp(i, j) = temp(i, j) + x(i, k) * y(k, j)
Next k
Next j
Next i
matrixmultiply = temp
End Function
Private Sub CommandButton1_Click()
Dim x(1 To 3, 1 To 3) As Double, y(1 To 3, 1 To 3) As Double, z() As Double
Dim i As Integer, j As Integer
For i = 1 To 3
For j = 1 To 3
x(i, j) = Cells(i, j).Value
y(i, j) = Cells(i, j + 5).Value
Next j
Next i
z = matrixmultiply(x, y)
For i = 1 To 3
For j = 1 To 3
Cells(i, j + 12).Value = z(i, j)
Next j
Next i
End Sub
Silly mistake in the line:
For k = 1 To col1
It should, instead, be
For k = 1 To ncol1
Using Option Explicit would have saved a lot of hurt!