Here you go. This should convert the links to values on the sheet from which the macro is executed.
Sub Remove_Links()
Dim x As Integer
Dim wks As Worksheet
Dim lf As Boolean
Dim lfn As Integer
Dim linked_file As String
Dim n As Names
Dim cell As Range
Dim lk As Variant
Dim wbk As Workbook
Dim curr_addr As String
Dim linked_cell As Boolean
Dim LinkedFiles() As Variant
On Error Resume Next
Application.ScreenUpdating = False
If CommandBars(1).Controls("Edit").Controls("Links...").Enabled = False Then
MsgBox "There are no links in this file.", , "Links Not Found"
Exit Sub
End If
For Each lk In ActiveWorkbook.LinkSources(xlExcelLinks)
x = x + 1
ReDim Preserve LinkedFiles(x)
For Each wbk In Workbooks
If wbk.FullName = lk Then
lk = wbk.Name
Exit For
End If
Next wbk
LinkedFiles(x) = lk
Next lk
For x = 1 To UBound(LinkedFiles)
lfn = Len(LinkedFiles(x))
lf = False
For y = lfn To 1 Step -1
If Mid(LinkedFiles(x), y, 1) = "" Then
linked_file = Left(LinkedFiles(x), y) & "["
linked_file = linked_file & Right(LinkedFiles(x), lfn - y)
lf = True
End If
If lf = True Then Exit For
Next y
If lf = False Then
linked_file = LinkedFiles(x)
End If
If WorksheetFunction.IsNumber(WorksheetFunction.Find("'", linked_file)) Then
linked_file = Left(linked_file, WorksheetFunction.Find("'", linked_file)) & "'" & Mid(linked_file, WorksheetFunction.Find("'", linked_file) + 1, 1000)
End If
Err.Clear
curr_addr = ActiveCell.Address
Cells.Find(What:=linked_file).Select
If Err.Number<> 91 Then
Call Select_Range(linked_file)
For Each cell In Selection
Application.StatusBar = "Converting... " & cell.Address
cell.Value = cell.Value
Application.StatusBar = False
Next cell
Range(curr_addr).Select
End If
Next x
Application.StatusBar = False
End Sub
Sub Select_Range(linked_file)
Dim Linked_Cells() As String
Dim Link_Range As Range
Dim x As Integer
On Error Resume Next
Cells.Find(What:=linked_file).Activate
First_Cell = ActiveCell.Address
Do Until Next_Cell = First_Cell
Cells.FindNext(After:=ActiveCell).Activate
If ActiveCell.HasFormula Then
Next_Cell = ActiveCell.Address
ReDim Preserve Linked_Cells(x)
Linked_Cells(x) = Next_Cell
If x = 0 Then
Set Link_Range = Range(Linked_Cells(0))
Else
Set Link_Range = Application.Union(Link_Range, Range(Linked_Cells(x)))
End If
x = x + 1
End If
Loop
Link_Range.Select
End Sub
_________________
It's never too late to learn something new.
Ricky
This message was edited by Ricky Morris on 2002-05-06 22:31
This message was edited by Ricky Morris on 2002-05-08 09:20