removing links to external workbooks

L

ll

I've been working with a vba script that works just fine when run from
the workbook from which it will remove links to external workbooks;
however, when I set the script up in one workbook to create a new
workbook, and then I activate and call the script from there, it fails
to remove the links. I've put msg boxes in place to check to be sure
that the script does run, and it does, although the links fail to
disappear.

Thanks for any help you might be able to provide.-Louis
Here is what I have:

=======
'This is the main module that calls the link remover ("Should
Delete"):

Sub timesheetGenerate()
Dim fillAmt As Long



'Open existing timesheet

Workbooks.Open Filename:=UserForm1.TextBox1.Value


LOldWb = ActiveWorkbook.Name


'////Add new workbook
Workbooks.Add
LNewWb = ActiveWorkbook.Name

'////Copy sheet one of existing timesheet
Windows(LOldWb).Activate
Sheets("Sheet1").Select
Cells.Select
Selection.Copy

'////Paste values from existing timesheet/sheet one, to the new
timesheet/sheet one.
Windows(LNewWb).Activate
Sheets("Sheet1").Select
Selection.PasteSpecial Paste:=xlPasteFormulasAndNumberFormats,
Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False


'////Populate sheet two of new timesheet with date range, in column A
Windows(LNewWb).Activate
Sheets("Sheet2").Select
Cells(1, 1).Select
'////populate cell A1 with the beginning date, from the vba form box
ActiveCell.Value = UserForm1.TextBox4.Value


'////fill the rest of the dates, using the fillAmt variable
fillAmt = UserForm1.TextBox3.Value
Selection.AutoFill Destination:=Range("A1:A" & fillAmt),
Type:=xlFillSeries


'////Copy sheet three of existing timesheet
Windows(LOldWb).Activate
Sheets("Sheet3").Select
Cells.Select
Selection.Copy


'////Paste values from existing timesheet/sheet three, to the new
timesheet/sheet three.
Windows(LNewWb).Activate
Sheets("Sheet3").Select
Selection.PasteSpecial Paste:=xlPasteFormulasAndNumberFormats,
Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False



'////Remove external links :)
Should_Delete


'////Save new timesheet and close
ActiveWorkbook.SaveAs Filename:=UserForm1.TextBox2.Value

ActiveWorkbook.Close


'////Close old timesheet
Windows(LOldWb).Activate
ActiveWorkbook.Close



End Sub

============================================


This is the "Should Delete" script:



'Option Base 1

'This macro deletes all formula links in a workbook.
'
'This macro does not delete a worksheet formula that references an
open
'book, for example:
'
' =[Book1.xls]Sheet1!$A$1
'
' To delete only the links in the active sheet, see the comments
' provided in the Delete_It macro later in this article.

Public Times As Integer
Public Link_Array As Variant

Sub Should_Delete()
Items = 0 'initialize these names
Times = 0
Link_Array = ActiveWorkbook.LinkSources 'find all document links

Items = UBound(Link_Array) 'count the number of links
For Times = 1 To Items

'Ask whether to delete each link
Msg = "Do you want to delete this link: " & Link_Array(Times)
Style = vbYesNoCancel + vbQuestion + vbDefaultButton2
response = MsgBox(Msg, Style)
If response = vbYes Then Delete_It
Delete_It
If response = vbCancel Then Times = Items
Next Times
End Sub



Sub Delete_It()
Count = Len(Link_Array(Times))
For Find_Bracket = 1 To Count - 1
'Replace the "\" in the next line with a ":" if you are using
'Microsoft Excel for the Macintosh.
If Mid(Link_Array(Times), Count - Find_Bracket, 1) = "\" _
Then Exit For


Next Find_Bracket
'Add brackets around the file name.
With_Brackets = Left(Link_Array(Times), Count - Find_Bracket) & _
"[" & Right(Link_Array(Times), Find_Bracket) & "]"

'Does the replace.

'If you want to remove links only on the active sheet, change the
'next two lines into comments by placing an (') apostrophe in
front of
'them as well as the line, "Next Sheet_Select", that closes the
loop.

For Each Sheet_Select In ActiveWorkbook.Worksheets

Sheet_Select.Activate
Set Found_Link = Cells.Find(what:=With_Brackets,
After:=ActiveCell, LookIn:=xlFormulas, lookat:=xlPart,
searchorder:=xlByRows, searchdirection:=xlNext, MatchCase:=False)
While UCase(TypeName(Found_Link)) <> UCase("Nothing")

Found_Link.Activate

On Error GoTo anarray

Found_Link.Formula = Found_Link.Value

Msg = "Do you want to delete formula also?"

Style = vbYesNo + vbQuestion + vbDefaultButton2

response = MsgBox(Msg, Style)

If response = vbYes Then
Found_Link.Formula = Found_Link.Value

Else

new_formula = Application.Substitute(Found_Link.Formula,
With_Brackets, "")

Found_Link.Formula = new_formula

End If


Set Found_Link = Cells.FindNext(After:=ActiveCell)

Wend
Next Sheet_Select 'To remove links only on the active sheet
'place an (') apostrophe at the front of this
line.

MsgBox "loop"


Exit Sub

anarray:
Selection.CurrentArray.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues
Resume Next

End Sub
 
R

Ron de Bruin

Look here for a few code examples
http://www.rondebruin.nl/values.htm



--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


ll said:
I've been working with a vba script that works just fine when run from
the workbook from which it will remove links to external workbooks;
however, when I set the script up in one workbook to create a new
workbook, and then I activate and call the script from there, it fails
to remove the links. I've put msg boxes in place to check to be sure
that the script does run, and it does, although the links fail to
disappear.

Thanks for any help you might be able to provide.-Louis
Here is what I have:

=======
'This is the main module that calls the link remover ("Should
Delete"):

Sub timesheetGenerate()
Dim fillAmt As Long



'Open existing timesheet

Workbooks.Open Filename:=UserForm1.TextBox1.Value


LOldWb = ActiveWorkbook.Name


'////Add new workbook
Workbooks.Add
LNewWb = ActiveWorkbook.Name

'////Copy sheet one of existing timesheet
Windows(LOldWb).Activate
Sheets("Sheet1").Select
Cells.Select
Selection.Copy

'////Paste values from existing timesheet/sheet one, to the new
timesheet/sheet one.
Windows(LNewWb).Activate
Sheets("Sheet1").Select
Selection.PasteSpecial Paste:=xlPasteFormulasAndNumberFormats,
Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False


'////Populate sheet two of new timesheet with date range, in column A
Windows(LNewWb).Activate
Sheets("Sheet2").Select
Cells(1, 1).Select
'////populate cell A1 with the beginning date, from the vba form box
ActiveCell.Value = UserForm1.TextBox4.Value


'////fill the rest of the dates, using the fillAmt variable
fillAmt = UserForm1.TextBox3.Value
Selection.AutoFill Destination:=Range("A1:A" & fillAmt),
Type:=xlFillSeries


'////Copy sheet three of existing timesheet
Windows(LOldWb).Activate
Sheets("Sheet3").Select
Cells.Select
Selection.Copy


'////Paste values from existing timesheet/sheet three, to the new
timesheet/sheet three.
Windows(LNewWb).Activate
Sheets("Sheet3").Select
Selection.PasteSpecial Paste:=xlPasteFormulasAndNumberFormats,
Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False



'////Remove external links :)
Should_Delete


'////Save new timesheet and close
ActiveWorkbook.SaveAs Filename:=UserForm1.TextBox2.Value

ActiveWorkbook.Close


'////Close old timesheet
Windows(LOldWb).Activate
ActiveWorkbook.Close



End Sub

============================================


This is the "Should Delete" script:



'Option Base 1

'This macro deletes all formula links in a workbook.
'
'This macro does not delete a worksheet formula that references an
open
'book, for example:
'
' =[Book1.xls]Sheet1!$A$1
'
' To delete only the links in the active sheet, see the comments
' provided in the Delete_It macro later in this article.

Public Times As Integer
Public Link_Array As Variant

Sub Should_Delete()
Items = 0 'initialize these names
Times = 0
Link_Array = ActiveWorkbook.LinkSources 'find all document links

Items = UBound(Link_Array) 'count the number of links
For Times = 1 To Items

'Ask whether to delete each link
Msg = "Do you want to delete this link: " & Link_Array(Times)
Style = vbYesNoCancel + vbQuestion + vbDefaultButton2
response = MsgBox(Msg, Style)
If response = vbYes Then Delete_It
Delete_It
If response = vbCancel Then Times = Items
Next Times
End Sub



Sub Delete_It()
Count = Len(Link_Array(Times))
For Find_Bracket = 1 To Count - 1
'Replace the "\" in the next line with a ":" if you are using
'Microsoft Excel for the Macintosh.
If Mid(Link_Array(Times), Count - Find_Bracket, 1) = "\" _
Then Exit For


Next Find_Bracket
'Add brackets around the file name.
With_Brackets = Left(Link_Array(Times), Count - Find_Bracket) & _
"[" & Right(Link_Array(Times), Find_Bracket) & "]"

'Does the replace.

'If you want to remove links only on the active sheet, change the
'next two lines into comments by placing an (') apostrophe in
front of
'them as well as the line, "Next Sheet_Select", that closes the
loop.

For Each Sheet_Select In ActiveWorkbook.Worksheets

Sheet_Select.Activate
Set Found_Link = Cells.Find(what:=With_Brackets,
After:=ActiveCell, LookIn:=xlFormulas, lookat:=xlPart,
searchorder:=xlByRows, searchdirection:=xlNext, MatchCase:=False)
While UCase(TypeName(Found_Link)) <> UCase("Nothing")

Found_Link.Activate

On Error GoTo anarray

Found_Link.Formula = Found_Link.Value

Msg = "Do you want to delete formula also?"

Style = vbYesNo + vbQuestion + vbDefaultButton2

response = MsgBox(Msg, Style)

If response = vbYes Then
Found_Link.Formula = Found_Link.Value

Else

new_formula = Application.Substitute(Found_Link.Formula,
With_Brackets, "")

Found_Link.Formula = new_formula

End If


Set Found_Link = Cells.FindNext(After:=ActiveCell)

Wend
Next Sheet_Select 'To remove links only on the active sheet
'place an (') apostrophe at the front of this
line.

MsgBox "loop"


Exit Sub

anarray:
Selection.CurrentArray.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues
Resume Next

End Sub
 
L

ll

Thanks,
Much appreciated link; however, I need the local formulas copied from
the workbook (with the link to the external workbook stripped).

Louis
 
D

Dave Peterson

Select the range to fix:
edit|replace
what: [*]
with: (leave blank)
replace all

=========
Alternatively, before you copy, you could use this technique:

Convert the formulas to strings, copy the worksheet, and convert those strings
back to formulas.

I like to do this:

Select all the cells
edit|Replace
what: = (equal sign)
with: $$$$$=
replace all

Then the copy.

And reverse the process:

Select all the cells
edit|Replace
what: $$$$$=
with: =
replace all
See the last macro on this pagehttp://www.rondebruin.nl/values.htm#break

Thanks again,
What I really am needing is, when given the following external link:
=[feb14_copy_values_test_a.xls]Sheet1!$B$1

to remove all between the brackets, to leave "Sheet1!$B$1"

Thanks,
Louis
 
L

ll

Dave,
Thanks so much for this - I've integrated it successfully with my
script, and now external links are gone. :)
Kind Regards,
Louis
 
T

Tom Ogilvy

That will certainly work - but if you grouped the sheets and copied them all
at once as I advised, you wouldn't have to do that or worry about removing
external references.

--
Regards,
Tom Ogilvy

ll said:
Dave,
Thanks so much for this - I've integrated it successfully with my
script, and now external links are gone. :)
Kind Regards,
Louis


Select the range to fix:
edit|replace
what: [*]
with: (leave blank)
replace all

=========
Alternatively, before you copy, you could use this technique:

Convert the formulas to strings, copy the worksheet, and convert those
strings
back to formulas.

I like to do this:

Select all the cells
edit|Replace
what: = (equal sign)
with: $$$$$=
replace all

Then the copy.

And reverse the process:

Select all the cells
edit|Replace
what: $$$$$=
with: =
replace all
 
T

Tom Ogilvy

I'll qualify that to add given the assumptions I previosly stated.

--
Regards,
Tom Ogilvy


ll said:
Dave,
Thanks so much for this - I've integrated it successfully with my
script, and now external links are gone. :)
Kind Regards,
Louis


Select the range to fix:
edit|replace
what: [*]
with: (leave blank)
replace all

=========
Alternatively, before you copy, you could use this technique:

Convert the formulas to strings, copy the worksheet, and convert those
strings
back to formulas.

I like to do this:

Select all the cells
edit|Replace
what: = (equal sign)
with: $$$$$=
replace all

Then the copy.

And reverse the process:

Select all the cells
edit|Replace
what: $$$$$=
with: =
replace all
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top