This solution assumes that references to other file are not created using INDIRECT function
- test on a
copy of your workbook first
VBA opens WB1 and searches cells in
Sheet1 for strings containing
[WB2.xlsx]Sheet2
Cells containing that string are added to range
Clr (which inititally is set to the last cell in column A to make coding simpler)
Cells in range
Clr are cleared in one hit
To test
- place VBA below in a module in a new workbook
- amend the 3 constant values to match your own
- run the macro
For testing purposes (to allow you to see if only the VBA is finding the correct cells)
- line added to colour the cells RED
- cell contents are not cleared
- WB1 is not closed
After successful test
- remove the line colouring cells red and remove the leading apostrophe on the other 2 lines
Option Explicit
Code:
Sub ClearValues()
Const lookFor = "[COLOR=#ff0000][WB2.xlsx]Sheet2[/COLOR]" 'string to find that identifies required link
Const Wb1 = "[COLOR=#006400]C:\folder\subfolder\WB1.xlsm[/COLOR]" 'full path and name of WB1
Const Sh1 = "[COLOR=#008080]Sheet1[/COLOR]" 'name of sheet in WB1
Dim Srch As Range, Cel As Range, Clr As Range, Addr As String, Wb As Workbook
Set Wb = Workbooks.Open(Wb1)
Set Srch = Wb.Sheets(Sh1).Cells
Set Clr = Srch(Srch.Rows.Count, 1)
Set Cel = Srch.Find(lookFor)
If Cel Is Nothing Then
MsgBox "Not found"
Exit Sub
End If
Addr = Cel.Address
Do
Set Clr = Union(Clr, Cel)
Set Cel = Srch.FindNext(Cel)
Loop While Addr <> Cel.Address
Clr.Interior.Color = [COLOR=#ff0000]vbRed[/COLOR] [COLOR=#006400]'delete after testing[/COLOR]
[COLOR=#ff0000]'[/COLOR]Clr.ClearContents [COLOR=#006400] 'remove leading apostrophe after testing[/COLOR]
[COLOR=#ff0000]'[/COLOR]Wb.Close False [COLOR=#006400]'remove leading apostrophe after testing[/COLOR]
End Sub