Interrupting Calculations
Normally, Excel calculates your workbooks so fast you don’t notice. Sometimes, however, your workbook is so big that it takes Excel some time to calculate it. I’m guessing readers of this blog run into that situation more than the average Joe. While Excel is calculating, the status bar displays its progress. If you continue to work during the calculation, Excel will pause its calculation so you can work at a normal speed. Nice feature, I think.
Excel in mid-calculation
Make a keystroke and it goes back to ready, but shows that more calc’ing is needed
I guess Microsoft is assuming that if you doing other things, you’re not really looking at the results. If you’re not looking at the results, it can wait until you’re done to finish calculating. For humans, I think that’s a fine assumption. For VBA code, not so much. Your code may be continuing on happily without knowing that the workbook isn’t fully calculated.
The Excel object model provides the Application.CalculationInterruptKey property to control how/if calculation can be interrupted. xlAnyKey is the default and it pauses whenever the user starts working. xlEscKey only pauses when the escape key is pressed. It’s used when you want to allow the user to interrupt calculation, but you want to make sure they do it explicitly and not by accident. xlNoKey prevents interruption. It seems that any time you calculate in code, you should set this property to xlNoKey, then set it back. Are there times it wouldn’t matter?
Thanks to Bill Manville for “discovering” the CalculationInterruptKey property.
Quick PivotTables
Sometime in the mid-1990s, a man named Lyle Lanley walked into Microsoft with an idea. Probably the greatest.... Oh, it's more of an Apple idea. "Just tell us the idea and we'll implement it", said Bill Gates.
I'm on a quest to rid my life of wizards. The wizards that Microsoft seems to use for every single command. It all started with fixing the find dialog as I grew tired of clicking the Options button. Then I saw an opportunity to speed up Text to Columns which is unnecessarily wizardish. Today's victim is the Pivot Table.
Have you seen the wizard for Pivot tables? They couldn't put that on one screen? Well I say, No more! I just want to make a pivot table:
- from an Excel range
- that I've already selected
- and I want it on a new sheet
Almost always. Unless I need something out of the ordinary, I'm using this code:
Sub CreatePivotTable()
Dim rData As Range
Dim shNew As Worksheet
Dim pcNew As PivotCache
Dim rCell As Range
Dim lFieldCnt As Long
Dim ptNew As PivotTable
Const sFIELD As String = "Field"
'Make sure a range is selected
If TypeName(Selection) = "Range" Then
Set rData = Selection.CurrentRegion
Set shNew = rData.Parent.Parent.Sheets.Add
'put column headers in blank cells
lFieldCnt = 1
For Each rCell In rData.Rows(1).Cells
If IsEmpty(rCell.Value) Then
rCell.Value = sFIELD & lFieldCnt
lFieldCnt = lFieldCnt + 1
End If
Next rCell
Set pcNew = shNew.Parent.PivotCaches.Add(xlDatabase, rData)
Set ptNew = shNew.PivotTables.Add(pcNew, shNew.Cells(1))
ptNew.AddFields rData.Rows(1).Cells(1).Text, rData.Rows(1).Cells(2).Text
ptNew.AddDataField ptNew.PivotFields(rData.Rows(1).Cells(3).Text)
End If
End Sub
Dim rData As Range
Dim shNew As Worksheet
Dim pcNew As PivotCache
Dim rCell As Range
Dim lFieldCnt As Long
Dim ptNew As PivotTable
Const sFIELD As String = "Field"
'Make sure a range is selected
If TypeName(Selection) = "Range" Then
Set rData = Selection.CurrentRegion
Set shNew = rData.Parent.Parent.Sheets.Add
'put column headers in blank cells
lFieldCnt = 1
For Each rCell In rData.Rows(1).Cells
If IsEmpty(rCell.Value) Then
rCell.Value = sFIELD & lFieldCnt
lFieldCnt = lFieldCnt + 1
End If
Next rCell
Set pcNew = shNew.Parent.PivotCaches.Add(xlDatabase, rData)
Set ptNew = shNew.PivotTables.Add(pcNew, shNew.Cells(1))
ptNew.AddFields rData.Rows(1).Cells(1).Text, rData.Rows(1).Cells(2).Text
ptNew.AddDataField ptNew.PivotFields(rData.Rows(1).Cells(3).Text)
End If
End Sub
Those last two lines add row, column, and data fields from the first three columns of the data. I don't like that, as it's prone to error. What I like less is what I get when I exclude those lines.
Compare four blank blue boxes to what you get via the user interface
I don't like the four blank squares and I don't like using the first three columns. I have to find something better.
Animate a greeting with Excel and VBA
Inspired by Dick's XL birthday, the upcoming birthday of my fiancee, and tinkering with iphone app development, I thought of an animated greeting in the form of a stadium wave (known to some as an audience wave)...
See http://www.tushar-mehta.com/publish_train/xl_vba_cases/greeting_wave.html
XL
If I were Roman, that's how old I would be today.
Today I will be spending my birthday processing inventory transactions and answering the phone - great fun. Tomorrow, however, we're having a little shindig in my honor with family, friends, and beer.
Euler Problem 83
Euler Problem 83 asks:
NOTE: This problem is a significantly more challenging version of Problem 81.
In the 5 by 5 matrix below, the minimal path sum from the top left to the bottom right, by moving left, right, up, and down, is indicated in red and is equal to 2297.
131 673 234 103 18 201 96 342 965 150 630 803 746 422 111 537 699 497 121 956 805 732 524 37 331Find the minimal path sum, in matrix.txt (right click and 'Save Link/Target As...'), a 31K text file containing a 80 by 80 matrix, from the top left to the bottom right by moving left, right, up, and down.
In the Problem 123 thread Doug Jenkins provided a spreadsheet solution for Problem 83, as well as suggesting an alternate method to solve the problem by padding the matrix. He thereby relieved a huge mental block of mine, but it's in the wrong thread. So I started this one.
Padding the matrix has its advantage. It allows you to use a common relationship in the area of interest without having to worry about variable subscripts being out of range because you'd otherwise reference a row or column that you haven't dimensioned (akin to trying to reference Row(0) on a spreadsheet.) There's some overhead to do this, but it saves special cases at the corners and borders. Doug recommended using 1000000, and that's as good a choice as any. With that in mind, the above matrix comes to look like this:
1000000 1000000 1000000 1000000 1000000 1000000 1000000 1000000 131 673 234 103 18 1000000 1000000 201 96 342 965 150 1000000 1000000 630 803 746 422 111 1000000 1000000 537 699 497 121 956 1000000 1000000 805 732 524 37 331 1000000 1000000 1000000 1000000 1000000 1000000 1000000 1000000
Since a picture = 1 kiloword, you can see how we have slop all the way around for subscripts, with the added advantage that if you make the matrix zero-based, the action starts at Row(1), Column(1). My mind likes it better that way. I used this same padding trick for Problem 67, where you can turn a triangle into a square. It really simplifies the code. With all that for background, here is my code that turns Doug's spreadsheet solution into VBA. It runs in about 3/10's of a second.
Sub Problem_083()
Dim Matrix(0 To 81) As Variant
Dim Cell(0 To 81, 0 To 81) As Long
Dim R As Long, C As Long
Dim Min As Long
Dim Answer As Long, T As Single
Dim TEMP1 As Long, TEMP2 As Long
Dim NumRows As Long, NumCols As Long
Dim IsTest As Boolean, i As Long
Const text As String = "D:\Downloads\Euler\matrix.txt"
T = Timer
R = 1
Open text For Input As #1 '80 lines, comma delimited
Do While Not EOF(1)
Line Input #1, Matrix(R) 'fills rows 1 to 80; 0 and 81 come later
R = R + 1
Loop
Close #1
IsTest = False
If IsTest Then
NumRows = 6
NumCols = 6
Matrix(1) = "131,673,234,103,18"
Matrix(2) = "201,96,342,965,150"
Matrix(3) = "630,803,746,422,111"
Matrix(4) = "537,699,497,121,956"
Matrix(5) = "805,732,524,37,331"
Else
NumRows = 81
NumCols = 81
End If
For C = 1 To NumCols - 1
Matrix(0) = Matrix(0) & "1000000 "
'adds top padding @(0), sets up TRIM()
Next C
Matrix(0) = Replace(Trim(Matrix(0)), " ", ",") 'makes it comma-delimited
Matrix(NumRows) = Matrix(0) ' adds bottom padding @(NumRows)
For R = 0 To NumRows
Matrix(R) = "1000000," & Matrix(R) & ",1000000"
' pads all rows left and right
Matrix(R) = Split(Matrix(R), ",")
'makes a zero-based NumRows X NumCols matrix
Next R
For R = 0 To NumRows
For C = 0 To NumCols
Cell(R, C) = CLng(Matrix(R)(C))
If C GT 0 Then Cell(R, C) = Cell(R, C) + Cell(R, C - 1)
' seeds the Cell array
Next C
Next R
Do
TEMP1 = Cell(NumRows - 1, NumCols - 1)
'start value of unpadded LR corner
i = i + 1 'counts iterations
For R = 1 To NumRows - 1 'inside the padding
For C = 1 To NumCols - 1 'inside the padding
If R = 1 And C = 1 Then 'reset Cell(1,1) from above
Cell(R, C) = CLng(Matrix(R)(C))
Else 'do the hard work
Min = Application.WorksheetFunction.Min(Cell(R + 1, C), Cell(R - 1, C), _
Cell(R, C + 1), Cell(R, C - 1))
Cell(R, C) = CLng(Matrix(R)(C)) + Min
End If
Next C
Next R
TEMP2 = Cell(NumRows - 1, NumCols - 1)
'finish value of unpadded LR corner
If i GT NumRows * NumCols Then Exit Do 'escape clause
Loop Until TEMP1 = TEMP2 'stable when start = finish
Answer = Cell(NumRows - 1, NumCols - 1)
Debug.Print Answer; " Time:"; Timer - T, i
End Sub
Dim Matrix(0 To 81) As Variant
Dim Cell(0 To 81, 0 To 81) As Long
Dim R As Long, C As Long
Dim Min As Long
Dim Answer As Long, T As Single
Dim TEMP1 As Long, TEMP2 As Long
Dim NumRows As Long, NumCols As Long
Dim IsTest As Boolean, i As Long
Const text As String = "D:\Downloads\Euler\matrix.txt"
T = Timer
R = 1
Open text For Input As #1 '80 lines, comma delimited
Do While Not EOF(1)
Line Input #1, Matrix(R) 'fills rows 1 to 80; 0 and 81 come later
R = R + 1
Loop
Close #1
IsTest = False
If IsTest Then
NumRows = 6
NumCols = 6
Matrix(1) = "131,673,234,103,18"
Matrix(2) = "201,96,342,965,150"
Matrix(3) = "630,803,746,422,111"
Matrix(4) = "537,699,497,121,956"
Matrix(5) = "805,732,524,37,331"
Else
NumRows = 81
NumCols = 81
End If
For C = 1 To NumCols - 1
Matrix(0) = Matrix(0) & "1000000 "
'adds top padding @(0), sets up TRIM()
Next C
Matrix(0) = Replace(Trim(Matrix(0)), " ", ",") 'makes it comma-delimited
Matrix(NumRows) = Matrix(0) ' adds bottom padding @(NumRows)
For R = 0 To NumRows
Matrix(R) = "1000000," & Matrix(R) & ",1000000"
' pads all rows left and right
Matrix(R) = Split(Matrix(R), ",")
'makes a zero-based NumRows X NumCols matrix
Next R
For R = 0 To NumRows
For C = 0 To NumCols
Cell(R, C) = CLng(Matrix(R)(C))
If C GT 0 Then Cell(R, C) = Cell(R, C) + Cell(R, C - 1)
' seeds the Cell array
Next C
Next R
Do
TEMP1 = Cell(NumRows - 1, NumCols - 1)
'start value of unpadded LR corner
i = i + 1 'counts iterations
For R = 1 To NumRows - 1 'inside the padding
For C = 1 To NumCols - 1 'inside the padding
If R = 1 And C = 1 Then 'reset Cell(1,1) from above
Cell(R, C) = CLng(Matrix(R)(C))
Else 'do the hard work
Min = Application.WorksheetFunction.Min(Cell(R + 1, C), Cell(R - 1, C), _
Cell(R, C + 1), Cell(R, C - 1))
Cell(R, C) = CLng(Matrix(R)(C)) + Min
End If
Next C
Next R
TEMP2 = Cell(NumRows - 1, NumCols - 1)
'finish value of unpadded LR corner
If i GT NumRows * NumCols Then Exit Do 'escape clause
Loop Until TEMP1 = TEMP2 'stable when start = finish
Answer = Cell(NumRows - 1, NumCols - 1)
Debug.Print Answer; " Time:"; Timer - T, i
End Sub
Doug mentions seeding the Cell array. This makes a huge difference. It goes through the Do-Loop only 5 times. The answer is known after 4 loops, but it takes 5 for the starting TEMP1 to know it. I couldn't figure out how to avoid that without apriori knowledge of the Answer, which is in the bottom right cell before the padding.
Playing with the spreadsheet solution, I made a third matrix of the array by "pasting special" a copy when all is stable. Then with conditional formatting comparing the two, I could see how the data flows and settles as I stepped through it. It starts from the upper left in kind of a maple-leaf pattern: Strong down the middle, with a spike above and below, and then a weak spike down the left side and the top edge. It takes 11 reps for everything to stabilize.
So, all in all, this is my VBA for Doug's concept. Stephen B and Josh G have other approaches, and hopefully, they'll share. This code is the combination of two half-good ideas I had. Maybe Doug will chime in, too. He's the one who gave me the clue about the whole approach.
The usual angle bracket corrections are in the code. It's interesting that it's Cell(R,C) but Matrix (R)(C) for the syntax.
...mrt
Euler Problem 81
Euler Problem 81 asks:
In the 5 by 5 matrix below, the minimal path Min from the top left to the bottom right,
by only moving to the right and down, is indicated in red and is equal to 2427.131 673 234 103 18 201 96 342 965 150 630 803 746 422 111 537 699 497 121 956 805 732 524 37 331Find the minimal path Min, in matrix.txt (right click and 'Save Link/Target As...'),
a 31K text file containing a 80 by 80 matrix, from the top left to the bottom right
by only moving right and down.
This is very similar to problems 18 and 67, except that they ask for the maximum path to the bottom, not the minimum path to the lower right corner. #81 can absolutely be done in a spreadsheet, as Tushar shows here for numbers 18 and 67. I like to solve them in VBA. The difference between this problem and #67 is that we have to get to a specific matrix cell, and by the rules, if we end up at the right edge, we can only go down, and if we end up at the bottom, we can only go right. In other words, on the right, progressively sum upwards from the lower right corner, and on the bottom, progressively sum leftwards from that same corner. The goal is to abstract the problem so the choice at matrix cell(0)(0) is the minimum of all paths to cell(0)(0). The answer will be the sum of cell(0)(0) and that minimum. Here is my code that does this. It runs in a blink (less that a tenth of a second.)
Sub Problem_081()
Dim Cell(0 To 79) As Variant
Dim R As Long, C As Long
Dim NumRows As Long, NumCols As Long
Dim Min As Long, IsTest As Boolean
Dim Answer As Long, T As Single
Const text As String = "D:\Downloads\Euler\matrix.txt"
T = Timer
R = 0
Open text For Input As #1 '80 lines, comma delimited
Do While Not EOF(1)
Line Input #1, Cell(R)
R = R + 1
Loop
Close #1
IsTest = False
If IsTest Then
NumRows = 4
NumCols = 4
Cell(0) = "131,673,234,103,18"
Cell(1) = "201,96,342,965,150"
Cell(2) = "630,803,746,422,111"
Cell(3) = "537,699,497,121,956"
Cell(4) = "805,732,524,37,331"
Else
NumRows = 79
NumCols = 79
End If
For R = 0 To NumRows
Cell(R) = Split(Cell(R), ",") ' making a NumRows X NumCols matrix
Next R
For C = NumCols - 1 To 0 Step -1 'rolling up right and bottom edges
R = C
Cell(NumRows)(C) = CLng(Cell(NumRows)(C)) + CLng(Cell(NumRows)(C + 1))
Cell(R)(NumCols) = CLng(Cell(R)(NumCols)) + CLng(Cell(R + 1)(NumCols))
Next C
For R = NumRows - 1 To 0 Step -1 'rolling up the minimums
For C = NumCols - 1 To 0 Step -1
Min = Application.WorksheetFunction.Min(CLng(Cell(R + 1)(C)), CLng(Cell(R)(C + 1)))
Cell(R)(C) = CLng(Cell(R)(C)) + Min
Next C
Next R
Answer = Cell(0)(0)
Debug.Print Answer; " Time:"; Timer - T
End Sub
Dim Cell(0 To 79) As Variant
Dim R As Long, C As Long
Dim NumRows As Long, NumCols As Long
Dim Min As Long, IsTest As Boolean
Dim Answer As Long, T As Single
Const text As String = "D:\Downloads\Euler\matrix.txt"
T = Timer
R = 0
Open text For Input As #1 '80 lines, comma delimited
Do While Not EOF(1)
Line Input #1, Cell(R)
R = R + 1
Loop
Close #1
IsTest = False
If IsTest Then
NumRows = 4
NumCols = 4
Cell(0) = "131,673,234,103,18"
Cell(1) = "201,96,342,965,150"
Cell(2) = "630,803,746,422,111"
Cell(3) = "537,699,497,121,956"
Cell(4) = "805,732,524,37,331"
Else
NumRows = 79
NumCols = 79
End If
For R = 0 To NumRows
Cell(R) = Split(Cell(R), ",") ' making a NumRows X NumCols matrix
Next R
For C = NumCols - 1 To 0 Step -1 'rolling up right and bottom edges
R = C
Cell(NumRows)(C) = CLng(Cell(NumRows)(C)) + CLng(Cell(NumRows)(C + 1))
Cell(R)(NumCols) = CLng(Cell(R)(NumCols)) + CLng(Cell(R + 1)(NumCols))
Next C
For R = NumRows - 1 To 0 Step -1 'rolling up the minimums
For C = NumCols - 1 To 0 Step -1
Min = Application.WorksheetFunction.Min(CLng(Cell(R + 1)(C)), CLng(Cell(R)(C + 1)))
Cell(R)(C) = CLng(Cell(R)(C)) + Min
Next C
Next R
Answer = Cell(0)(0)
Debug.Print Answer; " Time:"; Timer - T
End Sub
Having done #67, this was very straight forward. Problem #83, which uses the same matrix, is similar but harder. It's having its way with me. Here is #83:
NOTE: This problem is a significantly more challenging version of Problem 81.
In the 5 by 5 matrix below, the minimal path sum from the top left to the bottom right, by moving left, right, up, and down, is indicated in red and is equal to 2297.
131 673 234 103 18 201 96 342 965 150 630 803 746 422 111 537 699 497 121 956 805 732 524 37 331Find the minimal path sum, in matrix.txt (right click and 'Save Link/Target As...'), a 31K text file containing a 80 by 80 matrix, from the top left to the bottom right by moving left, right, up, and down.
Note the NOTE, the rules change, and the snaking path. It takes 12 moves, whereas #81 only takes 8. The minimum on the left depends on the minimum on the right. As Doug J has said, 'tis circular, and I've not grasped it yet. The various code I've written does the example, but either takes more than 6400 moves (visiting every cell several times) or ends up in an endless loop in the lower right corner of matrix.txt.
...mrt
Look Up
The last control on the right click menu is Look Up. That opens the Research task pane.
I'd be interested to know if anyone actually uses this. I accidentally click on it several times a week, but I don't actually use it. Anyone?
