Replace Cell References In Formulas With Their Actual Value
I am not sure how useful the actual functionality that the code below invokes, but I think the underlying techniques might prove useful for other coding endeavors you might undertake. Someone in another forum asked the following question (I am paraphrasing it here)...
"If the formula in my cell has three different cell references all on different sheets, such as...
=Sheet1!C3+Sheet2!F5+Sheet3!H7
then how do I get it to display the same formula, but with the cell references replaced by the cell values? For example, if Sheet1!C3 contained 123 and Sheet2!F5 contained 456 and Sheet3!H7 contained 789, then how do I get this formula returned to me?
=123+456+789
The solution involves one of the object structures that I just cannot believe VBA could not have implemented in some better way. The macro solution involves displaying the Formula Auditing Trace Precedents Arrows from sheet to sheet and cell to cell, and then following (navigating) each arrow to its source worksheet and then iterating each cell that the navigation links to. While the macro's code is not really all that complex, the idea and actions to implement it were, well for lack of a better word, cumbersome. Here is the code I came up with, although I would not be surprised to learn there is better code available... be sure to read the note following it.
Code:
Sub CheckCellReferences()
Dim ShapeCount As Long, Arrow As Long, Link As Long, Addr As String, Frmla As String
Dim Cell As Range, CurrentCell As Range, OriginalSheet As String, OriginalCell As String
Application.ScreenUpdating = False
OriginalSheet = ActiveSheet.Name
OriginalCell = ActiveCell.Address
ShapeCount = ActiveSheet.Shapes.Count
For Each Cell In Selection
Set CurrentCell = Cell
Frmla = Replace(CurrentCell.Formula, "$", "")
If CurrentCell.HasFormula Then
CurrentCell.ShowPrecedents
Link = 1
For Arrow = 1 To ActiveSheet.Shapes.Count - ShapeCount
On Error Resume Next
Do
CurrentCell.Parent.Activate
CurrentCell.Activate
Addr = CurrentCell.NavigateArrow(True, Arrow, Link).Address
If Err.Number Then
Link = 1
Exit Do
End If
Frmla = Replace(Frmla, ActiveCell.Address(0, 0), ActiveCell.Value)
Frmla = Replace(Frmla, ActiveCell.Parent.Name & "!", "")
Frmla = Replace(Frmla, "'" & ActiveCell.Parent.Name & "'!", "")
Link = Link + 1
Continue:
Loop
Cell.Offset(, 1) = Frmla
Next
CurrentCell.ShowPrecedents Remove:=True
End If
Worksheets(OriginalSheet).Activate
Range(OriginalCell).Activate
Next
Application.ScreenUpdating = False
End Sub
NOTE: If your formula has a text value that looks like a cell reference, for example the A12 in "Serial Number A12-345", and one of the cell references in the formula is actually A12, then the A12 inside the text constant will be replaced along with the actual cell reference in the formula... I do not know a way around this should it occur.
