Code To Extract Formula From a Cell

[Excello]

Dear All,

First, I want to wish this board & you all a very happy & prosperous new year.

My issue, is that I have a cell "B5" contain a link to another WorkSheet in the same WorkBook, the Cell contains (='BABY NEEDS'!AB19), while the WorkSheet "BABY NEEDS" Cell AB19 house a value of $ 550.

I just want a simple code to tell me the context of Cell "B5" (and not the value of it), or in other words, I want to now what is the function written in Cell "B5" as a text so I can extract the linked Sheet Name by using any of the text functions.

Can you help me on this?

Thanks in advance.

Excello.

 

[Excello]

Hi,

I am still waiting for any assistance on how to perform the above fuctions thru a vba code.

Any ideas around here ??

Excello

 

[Aladin Akyurek]

On 2003-01-02 17:27, Excello wrote:
Hi,

I am still waiting for any assistance on how to perform the above fuctions thru a vba code.

Any ideas around here ??

Excello

You could instruct your users to put the morefunc folder in their home directory and to activate the add-in from that folder.

 

[Tom Urtis]

Perhaps this macro may help. Place it in a standard VBA module, then activate the sheet containing the formulas, and run the macro.

It will create a new sheet, list your formulas, and separate them by sheet name and cell reference with the help of Andrew Poulsom's formulas. The root idea for the macro structure came from something similar posted by Dave Peterson last year, so thanks to him also.

Tested on XL2K2 XP.

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Sub ListFormulas()

Dim SourceSheet As Worksheet
Dim cell As Range
Dim counter As Long, LastRow As Long, iRow As Long, AllFormulas As Long

Set SourceSheet = ActiveSheet

Application.ScreenUpdating = False

With Worksheets.Add(after:=Sheets(Sheets.count))

Application.DisplayAlerts = False
On Error Resume Next
Worksheets(Left(SourceSheet.Name, 22) & "_Formulas").Delete
On Error GoTo 0
Application.DisplayAlerts = True

.Name = Left(SourceSheet.Name, 22) & "_Formulas"
.Range("A1").Value = "Formulas on Sheet " & SourceSheet.Name & ":"
.Range("C:D").NumberFormat = "@"

Range("A3").Value = "Cell Count"
Range("B3").Value = "Cell Address"
Range("C3").Value = "Formula, standard"
Range("D3").Value = "Formula, RC"
Range("E3").Value = "Sheet name, standard"
Range("F3").Value = "Cell ref, standard"
Range("G3").Value = "Sheet name, RC format"
Range("H3").Value = "Cell ref, RC format"
Range("A1,A3:H3").Font.Bold = True

counter = 0
On Error Resume Next
AllFormulas = SourceSheet.Cells.SpecialCells(xlCellTypeFormulas).Cells.count
For Each cell In SourceSheet.Cells.SpecialCells(xlCellTypeFormulas)
.Range("B4").Offset(counter, 0).Value = cell.Address(0, 0)
.Range("C4").Offset(counter, 0).Value = cell.Formula
.Range("D4").Offset(counter, 0).Value = cell.FormulaR1C1
counter = counter + 1
Next cell
On Error GoTo 0

Range("B3").CurrentRegion.Sort Key1:=.Range("D3"), Header:=xlYes

LastRow = .Cells(.Rows.count, 2).End(xlUp).Row
For iRow = LastRow To 4 + 1 Step -1
If .Cells(iRow, 4).Value = .Cells(iRow - 1, 4).Value Then
.Cells(iRow - 1, 2).Value = .Cells(iRow - 1, 2).Value & ", " & .Cells(iRow, 2).Value
.Rows(iRow).Delete
End If
Next iRow

With .Range("A4:A" & .Cells(.Rows.count, 2).End(xlUp).Row)
.Formula = "=len(B4)-len(substitute(B4,"","",""""))+1"
.Value = .Value
End With

Range("E4", Range("C65536").End(xlUp).Offset(0, 2)).Formula = "=IF(ISERROR(SUBSTITUTE(MID(RC[-2],2,FIND(""!"",RC[-2],1)-2),""'"","""")),"""",SUBSTITUTE(MID(RC[-2],2,FIND(""!"",RC[-2],1)-2),""'"",""""))"
Range("F4", Range("D65536").End(xlUp).Offset(0, 2)).Formula = "=RIGHT(RC[-3],LEN(RC[-3])-FIND(""!"",RC[-3],1))"
Range("G4", Range("E65536").End(xlUp).Offset(0, 2)).Formula = "=IF(ISERROR(SUBSTITUTE(MID(RC[-3],2,FIND(""!"",RC[-3],1)-2),""'"","""")),"""",SUBSTITUTE(MID(RC[-3],2,FIND(""!"",RC[-3],1)-2),""'"",""""))"
Range("H4", Range("F65536").End(xlUp).Offset(0, 2)).Formula = "=RIGHT(RC[-4],LEN(RC[-4])-FIND(""!"",RC[-4],1))"

.Range("A:A").ColumnWidth = 10
.Range("B:H").Columns.AutoFit
.Rows.AutoFit

Application.Goto Range("A1"), True
Application.Goto Range("A4"), False
ActiveWindow.FreezePanes = True

End With

SourceSheet.Activate
Application.Goto Range("A1"), True

Application.ScreenUpdating = True

End Sub

 

[Andrew Poulsom]

Here is the VBA equivalent of my formulas:

Sub Test()
    Dim Rng As Range
    Dim Frm As String
    Dim WF As WorksheetFunction
    Dim Sh As String
    Dim Ref As String
'   *** Change sheet and range references to suit ***
    Set Rng = Worksheets("Sheet1").Range("B5")
    Frm = Rng.Formula
    Set WF = WorksheetFunction
    Sh = WF.Substitute(Mid(Frm, 2, WF.Find("!", Frm, 1) - 2), "'", "")
    Ref = Right(Frm, Len(Frm) - WF.Find("!", Frm, 1))
    MsgBox "Sheet is " & Sh
    MsgBox "Cell reference is " & Ref
End Sub

 

[Excello]

[No message]

 

[Excello]

Hi all,

Thanks Tom, I will test your code in a later stage.

Andrew, thanks for the code, but I got an error while running the code:

"Unable to get the Find property of the worksheetfunction class"

Here is where the code stops:
Sh = WF.Substitute(Mid(Frm, 2, WF.Find("!", Frm, 1) - 2), "'", "")

However the Find function is available to VBA, still I don't know where is the error with this line. Should we repeat the "WF." before each function in theis code?

Waiting your assistance.

Excello

 

[Andrew Poulsom]

What is the formula in cell B5 on Sheet1? Find will fail if the formula does not refer to another worksheet, ie it does not contain an exclamation mark.

Make sure you have the correct sheet and range references in:

Set Rng = Worksheets("Sheet1").Range("B5")

 

[Myproblem]

Here is a custom function that will return a cell's formula:

Function CellFormula(Rng As Range) As String
    CellFormula = Rng.Formula
End Function

Paste the code into a General module. Then enter this in a blank cell on your worksheet:

=CellFormula(B5)

and you will get ='BABY NEEDS'!AB19.

I have challenge to offset certain values, I mean this suggested formula CellFormula working fine, but I need to create formula which will do basicly like this:
=offset(CellFormula(B5);0;2)
this mean, i need to create formula based on cell B5 but target formula should be offset-ed with 2 columns.
I tried to do myself but I got error #VALUE!, since in my case formula is link to other sheet and Excel can not get value since it shows formula like: offset("=OtherSheet!B5";0;2). The problem is how to get rid of " " ", as I understand.
any idea.
thx