Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1
Default 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
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Excel 2003 freeze panes won't freeze top row only macbone2002 Excel Discussion (Misc queries) 3 April 22nd 23 02:07 AM
CLASS MODULE & SIMPLE MODULE FARAZ QURESHI Excel Discussion (Misc queries) 1 September 7th 07 09:32 AM
code in module A to not execute a Worksheet_SelectionChange sub of another module Jack Sons Excel Discussion (Misc queries) 4 December 11th 05 11:52 PM
Freeze formula results nicoleto Excel Programming 2 February 17th 04 07:55 AM
Variable from a sheet module in a class module in XL XP hglamy[_2_] Excel Programming 2 October 14th 03 05:48 PM


All times are GMT +1. The time now is 03:42 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"