I am working on a VBA script that sorts rows according to a couple of custom criteria. Since manipulating Excel rows is slow (big rows with various styles), I am doing the sorting through an object in memory:
Generate a jagged array representing the worksheet (containing only the relevant information used in the sorting process).
Sort the jagged array by applying a combination of quick-sort algorithm.
Regenerate the worksheet by using the sorted jagged array as a reference
Step 1 and 2 are only taking 0,84s to proceed (for my biggest worksheet). But the last step, re-generating the excel worksheet, takes a very long time: 129,11s in total !
Here is a simplified example of my code to regenerate the sheet:
Dim WS As Worksheet: Set WS = Worksheets("MySheet")
Dim EndRowIndex As Integer: EndRowIndex = WS.UsedRange.Rows.Count
Dim Destination As Integer: Destination = EndRowIndex + 1
Dim rowIndex As Integer
Dim i As Integer
For i = 1 To EndRowIndex
rowIndex = new_order_array(i)
WS.Rows(rowIndex).Copy
WS.Rows(destination).Insert Shift:=xlDown 'Copying the rows in the correct order at the bottom
destination = destination + 1 'incrementing the destination row (so it stays at the bottom)
Next
Application.CutCopyMode = False
WS.Rows("1:"& endRowIdex ).Delete 'Deleting the old unordered rows from the sheet
( new_order_array was generated in step 2, it has as many element as there are rows in the worksheet. It indicate which row need to be moved where: new_order_array(1) = 3, means that the row 3 need to become the row 1. )
As you can see, this is a simple but naive re-ordering. I copy every row in the correct order at the bottom, then delete every unordered row at the top.
In order to fully optimize the process, I would need to re-order the worksheet by using the minimal number of moves. Currently, regenerating a worksheet of N rows requires N copy-pasting, while moving rows cleverly would required at most N-1 moves. How can I find the smallest sequence of moves needed to re-order rows according to an array ?
I don't know were to begin my research for this task... are there existing algorithms on this subject ? Is this problem named (useful for keywords)? Did I miss something else that might improve performance (I have already disabled visual updates during the process)? Any help would be greatly appreciated.
Here's a fairly quick sorting algorithm in n steps.
The scrambled data:
'demo
Cells.Clear
Dim arr(1 To 100)
For i = 1 To 100
arr(i) = i
Next i
'scramble
Randomize
Dim rarr(1 To 100)
x = 100
While x > 0
r = Int(Rnd * x) + 1
rarr(101 - x) = arr(r)
arr(r) = arr(x)
x = x - 1
Wend
For i = 1 To 100
Cells(i, 1) = rarr(i)
Next i
The sort:
'sort
sp = 1 'start position
While sp < 101
If rarr(sp) = sp Then
WS.Rows(sp).Copy
WS.Rows(destination).Insert Shift:=xlDown
destination = destination + 1
sp = sp + 1
Else
d = rarr(rarr(sp))
rarr(rarr(sp)) = rarr(sp)
rarr(sp) = d
End If
Wend
For i = 1 To 100
Cells(i, 2) = rarr(i)
Next i
End Sub
The rarr array has been restored.
It works by swapping the first element with the element at the first element's position, and repeats this until the correct element is in position, copy/pastes it, and then moves onto processing element 2, and continues like this through the whole array.
It is guaranteed to work (on a contiguous set of integers 1..k) because once an element is in it's correct position, it is not referenced again.
I am having trouble getting Variants to subtract. I am pulling data from a spreadsheet and if one cell states a phrase then I need the code to subtract one cell from another. If the cell does not state a phrase then I need it to copy one cell to another. I can get the code to run but nothing happens.
Private Sub CommandButton1_Click()
Dim x As Variant, y As Variant, z As Variant, a As Integer, B As String
'getting values for data
x = Range("D2:D48").Value
y = Range("I2:I48").Value
z = Range("E2:E48").Value
B = "Total ISU Days: "
'The the cells are empty then subtract. This is not what I wanted to do but I can't think of extracting strings from variants.
If IsEmpty(Range("D2:D48").Value) = True Then
a = y - z
End If
Range("N2:N48").Value = a
Range("M2:M48").Value = B
End Sub
x = Range("D2:D48").Value
y = Range("I2:I48").Value
z = Range("E2:E48").Value
A Variant contains metadata about its subtype. In this case, x, y, and z are all arrays of variants.
a = y - z
The right-hand side of this expression simply cannot be evaluated, because {array1} - {array2} means nothing: operators (arithmetic or logical) work off values, not array of values.
What is a supposed to be? It's declared As Integer, so its value is capped at 32,767 (should probably be a Long). If you mean to add up all the values in y and subtract that total from the sum of all values in z, then you need to be more explicit about how you do that - you could use Application[.WorksheetFunction].Sum to add things up:
sumOfY = Application.Sum(Range("I2:I48"))
sumOfZ = Application.Sum(Range("E2:E48"))
a = sumOfY - sumOfZ
And then...
Range("N2:N48").Value = a
That will put the value of a in every single cell in the N2:N48 range - is that really what you mean to do?
Or maybe you meant to do this instead?
Range("N2:N48").Formula = "=IF(D2="""",I2-E2,0)"
That would make each cell in N2:N48 calculate the difference between I and E for each row where D is empty... and there's not really any need for any VBA code to do this.
Let's simplify a bit the task and say that the idea is to substract the values in Range("C1:C6") from the corresponding values in the left - Range("B1:B6"). Then write the corresponding results in column E:
Of course, this would be done only in case that all values in column A are empty. This is one way to do it:
Sub TestMe()
Dim checkNotEmpty As Boolean: checkNotEmpty = False
Dim substractFrom As Range: Set substractFrom = Worksheets(1).Range("B1:B6")
Dim substractTo As Range: Set substractTo = Worksheets(1).Range("C1:C6")
Dim MyCell As Range
Dim result() As Variant
ReDim result(substractFrom.Cells.Count - 1)
Dim areCellsEmpty As Boolean
For Each MyCell In substractFrom
If Len(MyCell) > 0 Then checkNotEmpty = True
Next
Dim i As Long
For i = LBound(result) + 1 To UBound(result) + 1
result(i - 1) = substractFrom.Cells(i) - substractTo.Cells(i)
Next
Worksheets(1).Range("E1").Resize(UBound(result) + 1) = Application.Transpose(result)
End Sub
The code could be improved further, saving all ranges to an Array, but it works quite ok so far.
The part with the +1 and -1 in the For-loop is needed as a workaround:
For i = LBound(result) + 1 To UBound(result) + 1
result(i - 1) = substractFrom.Cells(i) - substractTo.Cells(i)
Next
because the arrays start from index 0, but the Cells in a range start with row 1.
Worksheets(1).Range("E1").Resize(UBound(result) + 1) = Application.Transpose(result) is needed, to write the values of the result array to the column E, without defining the length of the range in E.
In this VBA program all I am trying to do is to pass an array from spreadsheet and add 1 to each of the array's cells. My problem is with the index of the array. when I start looping the array it doesnt
work when I start the index from zero ( I get error subscript out of range) but it works perfectly when I start the array from 1. Why is that? (I thought that would be the case only I specify at the top Option Base 1)
Sub Passarray()
Dim Array As Variant
Dim i, j As Integer
'Pass array and manipulate
Vol = Range("Volatility")
For i = 0 To 2
For j = 0 To 2
Vol(i, j) = 1+ Vol(i,j)
Next j
Next i
End Sub
That wasn't the case when you pass Range to arrays based on my experience.
I don't know the specific reason behind, but this link indicates that you cannot change this behavior.
QUOTE: The array into which the worksheet data is loaded always has an lower bound (LBound) equal to 1, regardless of what Option Base directive you may have in your module. You cannot change this behavior.
What you can do is to utilize the use of LBound/UBound like this:
Vol = Range("Volatility")
For i = LBound(Vol, 1) To UBound(Vol, 1)
For j = Lbound(Vol, 2) To Ubound(Vol, 2)
'~~> do stuff here
Vol(i, j) = 1 + Vol(i, j)
Next j
Next i
If however your Range is just one column with several rows, you pass it to Array like this:
Vol = Application.Transpose(Range("Volatility"))
For i = LBound(Vol) To UBound(Vol)
'~~> do stuff here
Vol(i) = 1 + Vol(i)
Next
This way, you will produce one-D array instead of two-D array.
To iterate values you can use above or you can also use For Each:
Dim x As Variant '~~> dimension another variant variable
For Each x In Vol
'~~> do stuff here
x = 1 + x
Next
I have a macro which is written to perform an OLS regression on data that is selected by the user. This is part of a larger add in that I am writing but I am stuck on what I think must be somewhat of a simple issue. I keep getting a subscript out of range error and I think its because I am getting a different sized matrix to what I am expecting.
The sub takes two variables as its arguments and calculated the OLS estimator given the specification. The y variable is always a n x 1 range (one column and multiple row) and the X variable is a n x m range (can be multiple columns and rows). When this function is used when X is a single column range, the For... Next block works for the following code:
For bcnt = 1 To k
Cells(bcnt, 1).Value = b(bcnt)
Next bcnt
But if the X variable is a multiple column range this won't work and it has to be the following:
For bcnt = 1 To k
Cells(bcnt, 1).Value = b(bcnt,1)
Next bcnt
I can't understand why as by my understanding b should always be a one dimensional array.
Would appreciate any help.
The actual sub:
Sub OLSregress(y As Variant, X As Variant)
Dim Xtrans, XtransX, XtransXinv, Xtransy As Variant
Dim outputsheet As Worksheet
Dim b As Variant
' The equation for this estimator is b=[X'X]^(-1)X'Y
Xtrans = Application.WorksheetFunction.Transpose(X)
XtransX = Application.WorksheetFunction.MMult(Xtrans, X)
XtransXinv = Application.WorksheetFunction.MInverse(XtransX)
Xtransy = Application.WorksheetFunction.MMult(Xtrans, y)
b = Application.WorksheetFunction.MMult(XtransXinv, Xtransy)
k = Application.WorksheetFunction.Count(b)
Set ouputsheet = Sheets.Add(, ActiveSheet)
ActiveSheet.Name = "Regression Output"
For bcnt = 1 To k
Cells(bcnt, 1).Value = b(bcnt, 1)
Next bcnt
End Sub
When you are referring to a range or are bringing in data from a sheet the array is always a 2 dimensional array. The first dimension is rows and the second is the columns.
This is a common point of confusion in VBA for excel because it's done without your intervention.
Your code is correct.
For more in-depth information check out this post
I sometimes work with symmetric matrices in MS-Excel (both v2007 and v2003).
Is there an option to help me to copy expressions from the lower triangle to the upper one?
It should be something like copy and paste/transponse but those functions normally work only with rectangular areas.
in the added picture you can see an exemple of an expression that I have to replicate by linking the symmetric value in the superior triangle of the matrix.
To get the number in the appropriate cell, we can use OFFSET and the cell address the forms the base of the table. Note that the formula will produce a *Circular Reference` error if entered in on the diagonal. The formula will work for both sides of the diagonal - you just have to decide which one will hold the data, and which will hold the formula.
Offset takes Row and Column to decide the target. By subtracting the base cell row and column from the current position, we can invert the row and columns, and get the data.
Using your example, with the origin of the table in B2, we end up with the following formula:
=OFFSET($B$2,COLUMN()-COLUMN($B$2),ROW()-ROW($B$2))
you can copy this formula into the cells, and get the reflection. Now you have the number, you can do any calculation you require on the reflection. Using your example, this would make the formula:
=10-OFFSET($B$2,COLUMN()-COLUMN($B$2),ROW()-ROW($B$2))
Result:
Using INDEX to make it non volatile would change the formula slightly. First, we would need a reference to the entire table, not just the top cell. Second, we would need to add 1 to the row/column calculation, as it refers to the first cell as row/column 1, not an offset of 0 as the previous formula.
=INDEX($B$2:$K$11,COLUMN()-COLUMN($B$2)+1,ROW()-ROW($B$2)+1)
and your example of 10-Cell would become:
=10-INDEX($B$2:$K$11,COLUMN()-COLUMN($B$2)+1,ROW()-ROW($B$2)+1)
As one of the above answers demonstrates, this can be done by using Excel formulas. I however find this to be a very tedious procedure. Especially if this is something you need to do on a regular basis. In that case VBA could save you a lot of time.
The following code will work on a square selection and fill the rest of the matrix no matter if it is the lower- or upper part of the matrix that is pre-filled.
Option Explicit
Sub FillSymetricMatrix()
Dim i As Integer, j As Integer
Dim SelRng As Range
Dim FillArea As String
Dim FRow As Integer
Dim FCol As Integer
Set SelRng = Selection
FRow = SelRng.Rows(1).Row
FCol = SelRng.Columns(1).Column
'Returns information about which area to fill
If ActiveSheet.Cells(FRow + SelRng.Rows.Count - 1, FCol).Value <> vbNullString Then 'Lower filled
If ActiveSheet.Cells(FRow, FCol + SelRng.Columns.Count - 1).Value = vbNullString Then 'Upper empty
FillArea = "Upper"
Else
FillArea = "Error"
End If
Else
If ActiveSheet.Cells(FRow, FCol + SelRng.Columns.Count - 1).Value <> vbNullString Then 'Upper filled
FillArea = "Lower"
Else
FillArea = "Error"
End If
End If
'Determines if the selection is square
If SelRng.Rows.Count <> SelRng.Columns.Count Then FillArea = "Error"
'Fills empty area of the square (symetric) matrix
Select Case FillArea
Case Is = "Upper"
For i = 0 To SelRng.Rows.Count - 1 Step 1
For j = 0 To SelRng.Columns.Count - 1 Step 1
If i <= j Then ActiveSheet.Cells(i + FRow, j + FCol).Value = ActiveSheet.Cells(j + FRow, i + FCol).Value
Next j
Next i
Case Is = "Lower"
For i = 0 To SelRng.Rows.Count - 1 Step 1
For j = 0 To SelRng.Columns.Count - 1 Step 1
If i <= j Then ActiveSheet.Cells(j + FRow, i + FCol).Value = ActiveSheet.Cells(i + FRow, j + FCol).Value
Next j
Next i
Case Else
MsgBox "The procedure cannot be performed on the current selection!"
End Select
End Sub
I guess what you need is a function which returns the "diagonal" value of a square matrix, e.g. for any X(j,k) return X(k,j)
Try this:
Function DIAGONAL(Arg As Range, Reference As Range) As Variant
Dim MyRow As Long, MyCol As Long
If Reference.Rows.Count <> Reference.Columns.Count Then
DIAGONAL = CVErr(xlErrRef)
Else
MyRow = Arg.Row - Reference.Row + 1
MyCol = Arg.Column - Reference.Column + 1
If MyRow < 1 Or MyCol < 1 Or MyRow > Reference.Rows.Count Or MyCol > Reference.Columns.Count Then
DIAGONAL = CVErr(xlErrNA)
Else
DIAGONAL = Reference(MyCol, MyRow)
End If
End If
End Function
once you entered this function in VBA, you can use it inside or outside your square matrix ... you just need to ensure that your argument (parameter: Arg) is within the matrix (parameter: Reference) ... or you get an #N/A error. Or you get a #REF error if the matrix isn't square.
So in your example you would enter into B4: =10-DIAGONAL(B4,$B$2:$K$11) and copy this throughout the lower triangle.
You can even transpose a complete matrix ... in your screen shot, move to cell B13, enter =DIAGONAL(B2,$B$2:$K$11) and copy 9x down & right
No buttons, no need to explicitely start a Sub ... any size of n x n matrix, handles strings and numbers, ...
Here is an example with VBA. Start with an un-filled table and a button.
Then make the button run the code:
Option Explicit
Private Sub symmButton_Click()
MakeSymmetric Range("B2")
End Sub
Public Sub MakeSymmetric(ByRef r As Range)
Dim M As Long
M = CountCols(r)
Dim vals() As Variant
vals = r.Resize(M, M).Value2
Dim i As Long, j As Long
For i = 2 To M
For j = 1 To i - 1
vals(i, j) = vals(j, i)
Next j
Next i
r.Resize(M, M).Value2 = vals
End Sub
Public Function CountCols(ByRef r As Range) As Long
If IsEmpty(r) Then
CountCols = 0
ElseIf IsEmpty(r.Offset(0, 1)) Then
CountCols = 1
Else
CountCols = r.Worksheet.Range(r, r.End(xlToRight)).Columns.Count
End If
End Function
and finally observe the results
Similar to Sean's solution, I would also use formulas. In order to get the transposed value, use this formula:
=INDEX($B$2:$G$7,COLUMN()-COLUMN($B$2)+1,ROW()-ROW($B$2)+1)
If you want to do a more complex operation (e.g. =10-[transposedValue]), I'd recommend you use a named range: Insert a new name, e.g. TransposedValuein the Name Manager. Instead of a cell link, provide the above formula. Now you can literally write the following formula in your matrix:
=10-TransposedValue
I have this way. As you said copy paste transpose work on rectangular range. And your problem is that you have a triangular range.
You will love this....
1). Select the square range containing your upper triangular matrix and Copy.
2). Select a cell in an empty place and do the following two steps
a.) Paste Special - Values
b.) Paste Special - Values - Transpose - Skip Blanks
And you have got your symmetric matrix :-)
Anil.
Mixing together Ja72's fill code with SeanC c's Excel function code, I think I can make a generic matrix template that is properly prefilled with the dynamic Excel formula. So dynamic, and can be reused without any copy and paste.
Public Sub MakeSymmetric(ByRef r As Range)
Dim M As Long
M = 300
' Was CountCols(r), but I just limited to 300 columns for now
Dim vals() As Variant
vals = r.Resize(M, M).Value2
Dim i As Long, j As Long
For i = 2 To M
For j = 1 To i - 1
vals(j, i) = "=OFFSET($B$2,COLUMN()-COLUMN($B$2),ROW()-ROW($B$2))"
Next j
'Make diagonal down the middle show ---
vals(j, i) = "---"
Next i
vals(1, 1) = "---"
r.Resize(M, M).Value2 = vals
End Sub
Sub FillSymmetric()
MakeSymmetric Range("B2")
End Sub
I don't really know any VB though, so I haven't quite figured out how to fill the header yet. I don't know Stackoverflow yet either, but I will try to add a picture.
Original List to Matrixize
Dynamically transposing values typed in SouthWest half to NorthEast half
Short answer: INDIRECT(ADDRESS(COLUMN(D2), ROW(D2)))
Explnation: you may remember we use coordinates with numbers to represent a location in Cartesian Coordinates System. So, it's easy to get a diagonal symmetric value e.g. just change (2, 3) to (3, 2).
But in Excel, we need a wordaround if we want to do so. Because, address is marked by a combination of a letter and a digit, say B2. You can't just change B2 to 2B.
Luckily, we can still use numbers to represent a cell by leveraging the power of COW() and COLUMN().
In the image below, C2 and B3 are symmetrical. This shows how to put the value of C2 to B3.
Making the formula from C.W. more generic (similar to Peter Albert), this will help when your matrix is not starting at A1 but e.g. in C10:
=INDIRECT(ADDRESS(COLUMN(C11)-COLUMN($C$10)+1,ROW(C11)-ROW($C$10)+1))
So, subtract the origin row/column and add 1.