Code to loop through cells and find component of Formula

[godawgs85]

Hi Everyone,

I'll try to make this short and sweet.

I'm working on a financial modeling project and need a little help. I've been developing a financial model in excel using an add-in called Spreadsheet Server, which links to accounting software and allows you to pull in financial data by using a formula with several parameters.

The model is complete however I'm wanting to create a macro to loop through the cells on each tab of the model, and replace the Spreadsheet Server add-in formulas with values. In other words, I want standard excel formulas to stay intact while the add-in formulas will be copied over as values. This way we can send the model to other users who don't have the SS add-in and they can still manipulate it. A common theme to the SS add-in formulas is that they all are written as GXL(parameter, parameter, etc.). I figure there has to be a way I can loop through each cell, find if it contains "GXL" in the written formula, and then copy that cell as a value.

I'm having a little trouble figuring out what is the best method to take that will accurately find every applicable cell and copy it as a value efficiently (I have over 50 tabs in which I will need to copy values so run-time speed is important.) Any ideas?

Many thanks in advance,

godawgs85

[Bob Phillips]

What differentiates an SS addin formula from a standard Excel formula?

[Kenneth Hobs]

Delete or comment out SpeedOn and SpeedOff if you don't use my Module from the commented link.
[vba]Sub Test_FoundFormulaRanges()
Dim findRange As Range, findString As String, foundRange As Range
Dim r As Range, i As Long, ws As Worksheet

On Error GoTo EndNow:
'http://vbaexpress.com/kb/getarticle.php?kb_id=1035
SpeedOn

For Each ws In Worksheets
Set findRange = ws.Cells.SpecialCells(xlCellTypeFormulas)
findString = "=GXL("
Set foundRange = FoundFormulaRanges(findRange, findString)
If Not foundRange Is Nothing Then
foundRange.Value = foundRange.Value
End If
Next ws

EndNow:
SpeedOff
End Sub


Function FoundFormulaRanges(fRange As Range, fStr As String) As Range
Dim objFind As Range
Dim rFound As Range, FirstAddress As String

With fRange
Set objFind = .Find(what:=fStr, After:=fRange.Cells(fRange.Rows.Count, fRange.Columns.Count), _
LookIn:=xlFormulas, lookat:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
If Not objFind Is Nothing Then
Set rFound = objFind
FirstAddress = objFind.Address
Do
Set objFind = .FindNext(objFind)
If Not objFind Is Nothing Then Set rFound = Union(objFind, rFound)
Loop While Not objFind Is Nothing And objFind.Address <> FirstAddress
End If
End With
Set FoundFormulaRanges = rFound
End Function

[/vba]

[godawgs85]

Thanks Kenneth,

The code works well in replacing all of the SS add-in formulas. What's wierd, however, is that some of the formulas are converted to values but then on others, the formula is erased but instead of showing the value #N/A is displayed. Any idea what might be causing this?

Thanks!

[godawgs85]

What differentiates an SS addin formula from a standard Excel formula?

To answer your question the SS add-in formula is a specific formula built for the add-in to bring in data from an accounting server. The formula is GXL() and has several different parameters to bring in whatever account codes you want to display. The cells that contain this GXL() formula are the cells I want to replace with values. Other standard excel formulas I want to keep as they are.

Thanks

[Kenneth Hobs]

Something may be triggering an event.

[vba]
Application.EnableEvents = False
' do cell changes
Application.EnableEvents = True[/vba]

While testing, if an error occurs, put the last line in the Immediate window and press Enter to restore events.

[godawgs85]

Something may be triggering an event.

[vba]
Application.EnableEvents = False
' do cell changes
Application.EnableEvents = True[/vba]

While testing, if an error occurs, put the last line in the Immediate window and press Enter to restore events.

Just tried this and it doesn't seem that an error is occuring. The code works even upon taking the error handling out however there are still some cells that copy properly and others that display "#N/A".

I feel like we're really close but I'm stumped as to why some work and others do not. Any other ideas as to what might be causing it?

Thanks!

[Kenneth Hobs]

Post a short example with the problem. Add a single quote to keep the formula from calculating.

[chensi]

THANK YOU
i think i should thank you very much for you can waste lot of time to write this post .....thank

you again for your sharing..


_________________________________________________________________
I live my life in colour and see in soundMake sure you are heard!

[godawgs85]

Post a short example with the problem. Add a single quote to keep the formula from calculating.

Kenneth,

Attached is an example file of what I've been working on. I'm still having trouble getting it to copy over each formula with values. Thanks in advance for any help you can provide.

Tyler

[Kenneth Hobs]

Since "=GXL(" does not exist look for "GXL(".


[VBA]Sub Test_FoundFormulaRanges()
Dim findRange As Range, findString As String, foundRange As Range
Dim r As Range, i As Long, ws As Worksheet

On Error GoTo EndNow:
'http://vbaexpress.com/kb/getarticle.php?kb_id=1035
'SpeedOn

For Each ws In Worksheets
Set findRange = ws.Cells.SpecialCells(xlCellTypeFormulas)
findString = "GXL("
Set foundRange = FoundFormulaRanges(findRange, findString)
If Not foundRange Is Nothing Then
foundRange.Value = foundRange.Value
End If
Next ws

EndNow:
'SpeedOff
End Sub


Function FoundFormulaRanges(fRange As Range, fStr As String) As Range
Dim objFind As Range
Dim rFound As Range, FirstAddress As String

With fRange
Set objFind = .Find(what:=fStr, After:=fRange.Cells(fRange.Rows.Count, fRange.Columns.Count), _
LookIn:=xlFormulas, lookat:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
If Not objFind Is Nothing Then
Set rFound = objFind
FirstAddress = objFind.Address
Do
Set objFind = .FindNext(objFind)
If Not objFind Is Nothing Then Set rFound = Union(objFind, rFound)
Loop While Not objFind Is Nothing And objFind.Address <> FirstAddress
End If
End With
Set FoundFormulaRanges = rFound
End Function


[/VBA]

[godawgs85]

Just tried that and I'm still getting some of the values showing #N/A. Weird thing is now it's changing some of the values as well. I am perplexed....

[Kenneth Hobs]

Try using my Speed routines. It should help with the values changing. I don't know about the #NA though.

[ianswer]

Yes, those speed routines helped my program run faster.