Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Info Only: Formula Freeze Module
Thought I would post this code for posterity. I developed it with help from
this group. I use this module in conjuction with a simple user interface. It allows the user to develop a list of formulas to "freeze". When I say freeze, I mean paste the value of the formula to the cell. This is helpful for people who need to email formula-laden worksheets to others who do not have the requisite excel modules to use the formulas (in this case - Hyperion Retrieve). Email me to get the complete add-in with UI. Below is the guts of this addin. This code has been tested to a limited extent. However, the error trapping is not yet fully developed. As errors arise, I'll add to it. Public Function RecordAdd(strNewFormula As String) As Boolean 'This procedure expands range name for formula list and adds new record. 'The Range name is FormulaList and it must exist, or an error will occur. On Error Resume Next Dim lngRows As Long Dim rngTest As Range RecordAdd = False With Application .ScreenUpdating = False End With 'Test to see if forumla already exists in list. If it does, exit. With Application.Workbooks("Formula Freeze.xla").Sheets("List").Range("FormulaList") Set rngTest = .Find(strNewFormula) If Not rngTest Is Nothing Then Exit Function End If End With 'Add new formula to list. With Application.Workbooks("Formula Freeze.xla").Sheets("List").Range("FormulaList") lngRows = .Rows.Count + 1 .Cells(lngRows) = Trim(strNewFormula) .Resize(lngRows).Name = "FormulaList" RecordAdd = True End With With Application .ScreenUpdating = True End With Set rngTest = Nothing Exit Function End Function Public Sub RecordDelete(strFormula As String) On Error Resume Next 'This procedure contracts range name for formula list and deletes a record. Dim rngDelete As Range With Application .ScreenUpdating = False End With Set rngDelete = Application.Workbooks("Formula Freeze.xla").Sheets("List") _ .Range("FormulaList").Find(strFormula, LookIn:=xlValues) With rngDelete .Delete xlUp End With With Application .ScreenUpdating = True End With Set rngDelete = Nothing End Sub Public Sub Freeze(intOption As Integer) On Error Resume Next 'This procedure does the freezing of formulas based on user parameter. 'Key to parameters: '1 = Freeze all formulas in all sheets of the workbook. '2 = Freeze current sheet only. '3 = Freeze selected cells only. 'Branch to appropriate subroutine. Select Case intOption Case 1 FreezeAll Case 2 FreezeCurrent Case 3 FreezeSelected Case Else Exit Sub End Select End Sub Private Sub FreezeAll() On Error Resume Next Dim Wks As Worksheet Dim cell As Object With Application .ScreenUpdating = False .Calculation = xlCalculationManual End With 'Cycle through sheets collection. With Wks For Each Wks In ActiveWorkbook.Worksheets Wks.Activate For Each cell In ActiveSheet.UsedRange.Cells 'Cycle through all cells in UsedRange. If cell.HasFormula Then 'Only pass cells with formulas to the freezeme routine. FreezeMe Range(cell.Address) End If Next Next End With With Application .ScreenUpdating = False .Calculation = xlCalculationAutomatic End With End Sub Public Sub FreezeCurrent() On Error Resume Next Dim cell As Object With Application .ScreenUpdating = False .Calculation = xlCalculationManual End With 'Cycle through cells in usedrange in current sheet only. For Each cell In ActiveSheet.UsedRange.Cells If cell.HasFormula Then FreezeMe Range(cell.Address) End If Next With Application .ScreenUpdating = False .Calculation = xlCalculationAutomatic End With Set cell = Nothing End Sub Public Sub FreezeSelected() On Error Resume Next Dim cell As Object With Application .ScreenUpdating = False .Calculation = xlCalculationManual End With 'Cycle through cells in current selection only. For Each cell In Selection If cell.HasFormula Then FreezeMe Range(cell.Address) End If Next With Application .ScreenUpdating = False .Calculation = xlCalculationAutomatic End With Set cell = Nothing End Sub Private Sub FreezeMe(rngFreeze As Range) On Error Resume Next Dim strContents As String Dim strTest As String Dim rngTest As Range Dim rng As Range Set rng = rngFreeze 'Parse cell and store formula in string variable. strContents = rng.Formula 'Test contents to see if it is correct formula (e.g. =XXX(YY) and not +1+2+3. If InitialParse(strContents) Then 'Store only the formula name in the test string. strTest = Mid(Trim(strContents), 2, CLng(InStr(1, Trim(strContents), "(") - 2)) Else Exit Sub End If 'Search formula list for formula Set rngTest = Application.Workbooks("Formula Freeze.xla").Sheets("List") _ .Range("FormulaList").Find(strTest) If rngTest Is Nothing Then Exit Sub End If 'Formula is in the list, therefore, freeze cell. With rngFreeze .Copy .PasteSpecial xlPasteValues End With Set rngTest = Nothing Set rng = Nothing End Sub Private Function InitialParse(strValue As String) As Boolean 'This function tests to see if the character "(" exists in 'the formula. If it does not, InitialParse evaluates to false. On Error Resume Next Dim i As Integer InitialParse = False For i = 1 To Len(strValue) If Mid(strValue, i, 1) = "(" Then InitialParse = True End If Next End Function |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Excel 2003 freeze panes won't freeze top row only | Excel Discussion (Misc queries) | |||
CLASS MODULE & SIMPLE MODULE | Excel Discussion (Misc queries) | |||
code in module A to not execute a Worksheet_SelectionChange sub of another module | Excel Discussion (Misc queries) | |||
Freeze formula results | Excel Programming | |||
Variable from a sheet module in a class module in XL XP | Excel Programming |