Sub SubRefInFormula()
'Substitute into a formula the references with the formulas written in those references.
Dim xCol As String, xLig As String, xRef As String
Dim xFor1 As String, xFor2 As String
Dim Xsource As Range, xSub As Range, xDest As Range
Dim IsArray As Boolean
On Error GoTo FIN
' Selection of the initial formula
Set Xsource = Application.InputBox(Title:="Initial cell...", _
prompt:=" Select the cell containing the initial formula :?", _
Type:=8)
xFor1 = Xsource.FormulaLocal
IsArray = Xsource.HasArray
' Selection of the destination cell (could be the same ==> dangerous !)
Set xDest = Application.InputBox(Title:="Destination cell...", _
prompt:=" Select the cell that will contain the final formula :?", _
Type:=8)
AutreSubstitution:
'Loop until user clicks on 'Cancel' in the dialog box
Set xSub = Application.InputBox(Title:="Cell containing a formula", _
prompt:=" Select a cell with a formula to insert into the final formula :?" & _
vbLf & " - Cancel when no more replacement -", _
Type:=8)
If Not xSub.HasFormula Then GoTo AutreSubstitution
' The result formula may be an array formula or not
IsArray = IsArray Or xSub.HasArray
' Delete the sign "=" at the beginning of the formula
xFor2 = xSub.FormulaLocal
If Left(xFor2, 1) = "=" Then xFor2 = Right(xFor2, Len(xFor2) - 1)
' Get the row number and the column letters.
xCol = xSub.Address(True, False, xlA1)
xCol = Left(xCol, InStr(xCol, "$") - 1)
xLig = xSub.Address(True, False, xlA1)
xLig = Right(xLig, Len(xLig) - InStr(xLig, "$"))
' replace the string like $A1
xRef = "$" & xCol & xLig
xFor1 = Replace(xFor1, xRef, "(" & xFor2 & ")")
' replace the string like A$1
xRef = xCol & "$" & xLig
xFor1 = Replace(xFor1, xRef, "(" & xFor2 & ")")
' replace the string like $A$1
xRef = "$" & xCol & "$" & xLig
xFor1 = Replace(xFor1, xRef, "(" & xFor2 & ")")
' replace the string like A1
xRef = xCol & xLig
xFor1 = Replace(xFor1, xRef, "(" & xFor2 & ")")
' insert the new formula into the destination cell
xDest.FormulaLocal = xFor1
GoTo AutreSubstitution
FIN:
xDest.Select
' If Dest has a formula and if Dest might have an ARRAy formula
If xDest.HasFormula And IsArray Then
MsgBox "The result formula is certainly an array formula." & vbCrLf & vbCrLf & _
"Do not forget to validate it with Ctrl+Shift+Enter !"
' Edit the Dest formula so the user can immediately validate the formula
' with Ctrl+Shift+Enter if he want the dest formula to be an array formula.
Application.SendKeys ("{F2}")
End If
End Sub
Function TheFormulaLocal(xRG As Range) As String
TheFormulaLocal = xRG.FormulaLocal
End Function
Function TheFormula(xRG As Range) As String
TheFormula = xRG.Formula
End Function
