Excel Reference points to original file
 

Had some time at lunch so I quickly re-wrote it. Probably made it more
complicated than necessary but, oh well.
HTH,
Gary Brown

'/=============================================/
Public Sub ChangeFormula2Currwkbk()
'change references of formulas in range from
' another workbook to current workbook
'i.e.: change ='C:\Temp\[Book2]Sheet2'!A1 to
' =Sheet2!A1
Dim blnTF_Bracket_R As Boolean
Dim blnTF_Bracket_L As Boolean
Dim blnTF_SingleQuote As Boolean
Dim i As Double
Dim cell As Range, rng As Range
Dim strFormula As String
Dim strAddress As String
Dim strTempFormula As String
Dim varAnswer As Variant

On Error GoTo exit_Sub

'initialize variables
strAddress = Selection.Address
blnTF_Bracket_R = True
blnTF_Bracket_L = True
blnTF_SingleQuote = True

'get range to be changed
Set rng = Application.InputBox( _
Prompt:= _
"Select Range of formulas to be changed.", _
Title:= _
"Delete Reference to other workbooks", _
Default:=strAddress, Type:=8)

'only look in used area of the worksheet
Set rng = Intersect(rng.Parent.UsedRange, rng)

'error checking
If rng.Count = 1 Then
varAnswer = _
MsgBox("You have only selected one cell." & _
vbCr & "Continue?", vbInformation + vbYesNo, _
"Warning...")
End If

If varAnswer = vbNo Or varAnswer = vbCancel Then
Exit Sub
End If

varAnswer = vbNo

varAnswer = _
MsgBox("'UNDO' cannot be used to change the selected " _
& "cells back to their original values." & vbCr & _
"Do you wish to continue?", vbExclamation + vbYesNo, _
"Warning...")

If varAnswer = vbNo Or varAnswer = vbCancel Then
Exit Sub
End If

'adj the selected formulas
For Each cell In rng
strTempFormula = ""
If cell.HasFormula Then
strFormula = cell.Formula
For i = Len(strFormula) To 1 Step -1
If Mid(strFormula, i, 1) = "'" Then
If blnTF_SingleQuote = False Then
blnTF_SingleQuote = True
blnTF_Bracket_L = True
End If
Else
blnTF_SingleQuote = False
End If
If Mid(strFormula, i, 1) = "]" Then
blnTF_Bracket_R = False
End If
If Mid(strFormula, i, 1) = "[" Then
blnTF_Bracket_L = False
blnTF_Bracket_R = True
End If

If blnTF_Bracket_R = True And _
blnTF_Bracket_L = True Then
strTempFormula = _
Mid(strFormula, i, 1) & _
strTempFormula
End If

Next i
End If
cell.Formula = strTempFormula
Next cell

exit_Sub:
Set rng = Nothing

End Sub
'/==================================/


"Gary Brown" wrote:

Kumar,
I wrote this a while ago. It only works if both files are open. Take it
for what it's worth.
Hope it helps,
Gary Brown

SKS