Home |
Search |
Today's Posts |
#1
![]() |
|||
|
|||
![]()
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 |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Excel 2003 FAILS, but Excel 2000 SUCCEEDS ??? | Excel Discussion (Misc queries) | |||
Read Text File into Excel Using VBA | Excel Discussion (Misc queries) | |||
Excel 2000 file when opened in Excel 2003 generates errors? | Excel Discussion (Misc queries) | |||
double click a xls file and start Excel but without the file | Excel Discussion (Misc queries) | |||
Saving a Excel 97 file into Excel 2003 file | Excel Discussion (Misc queries) |