|
Thursday, October 15, 2009 - 2:42 PM
This is to overcome a bug in Excel that prevents the .calculate method from working while code is running. If this seems expensive for the CPU, it's negligible relative to calc'ing a large complex wb or ws unncessarily.
Note this code assumes formulas are line-item style – meaning they don't reference other rows on the sheet. If your formulas don't conform to that style, then you will need to determine the cells that calculate last in a workbook or on a given sheet. You could use code to determine that. I use a whole row of cells because testing only one cell would yield a false positive much more frequently.
(See here for LastRowWFormula function.)
Public DebugMode As Boolean, StopOnErrors As Boolean
Public Sub myCalculate(Optional WSName$, Optional WBName$)
'this is basically designed for sheets with data/formula ranges that are full of data from top to bottom and left to right, but it could be generalized
'could also be extended to loop all sheets if WSName is empty, but it's mainly intended for calculating one sheet at a time
'uses DebugMode and StopOnErrors public variables and HideVBE function (see Error Handling category of this site), but removing them wouldn't affect this sub
Dim wsCalc, i&, j&, LRow&(), tempInt&, tempStr$, bTest(3) As Boolean, WasHidden As Boolean, sStatusBar$
sStatusBar = Application.StatusBar: Application.StatusBar = "Calculating..."
On Error Resume Next 'although infrequently, certain data in cells can cause a type error, possibly only in older versions of excel
'tell XL to calc
If TestLen(WSName) Then
bTest(1) = True: Set wsCalc = Sheets(WName): wsCalc.Calculate
Else
Set wsCalc = Sheets([Your Default Sheet]): Calculate
End If
With wsCalc
'test if last row of each column calc'd
If WSIsEmpty(wsCalc) Then GoTo ExitNow 'no data
tempInt = .UsedRange.Columns.Count + .UsedRange.Column - 1
For j = 1 To tempInt
LRow(j) = LastRowWFormula(.Name, j)
If Not IsError(Application.Evaluate(.Cells(LRow(j), j).Formula)) Then
If (.Cells(LRow(j), j) <> Application.Evaluate(.Cells(LRow(j), j).Formula)) Then bTest(2) = True: Exit For
End If
Next
If bTest(2) Then 'didn't calc yet
If Not .Visible Then .Visible = True: WasHidden = True
.Select 'this helps convince XL to calc the ws
For i = 1 To 1000
'tell XL to calc
If bTest(1) Then .Calculate Else Calculate
'test if last row calc'd
bTest(2) = False: bTest(3) = False
For j = 1 To tempInt
If Not IsError(Application.Evaluate(.Cells(LRow(j), j).Formula)) Then
If Not bTest(3) Then bTest(3) = True
If (.Cells(LRow(j), j) <> Application.Evaluate(.Cells(LRow(j), j).Formula)) Then bTest(2) = True: Exit For
End If
Next
If Not bTest(3) Or Not bTest(2) Then GoTo ExitNow 'it calc'd or there was nothing to test
Next
If DebugMode And StopOnErrors Then
MsgBox ("Please check '" & sName & "' sheet to make sure it calculated.")
Stop: HideVBE
End If
End If
If WasHidden Then .Visible = False
End With
ExitNow: Application.StatusBar = sStatusBar
End Sub
|
|
| << Navigate to Thursday, October 15, 2009 |
Add New Comment |