Is there a way with VBA and/or some formula in Excel to check whether there are other workbooks/sheets referencing a cell? Ideally, also from which workbooks/sheets but if this is not possible, that's also ok.
Lets say I have a workbook with a list of proxy addresses, I want to know if a proxy is already being used by checking if there's any other workbook referencing its cell. This is to have an indicator whether it's a free proxy or already in use.
Any alternative solution that's close to this is also welcome. I'm not per se looking for a full blown solution, but I can get far by pointing me in the right direction.
On the Formulas tab, in the Defined Names group, click Name Manager. Check each entry in the list, and look in the Refers To column for external references. External references contain a reference to another workbook, such as [Budget.
How to reference another sheet in Excel. To reference a cell or range of cells in another worksheet in the same workbook, put the worksheet name followed by an exclamation mark (!) before the cell address. For example, to refer to cell A1 in Sheet2, you type Sheet2!
Here is some code, there is some setup code so that you (or other collaborators) can run thru an example of two workbooks, one pointing to another. Two workbooks get saved to your Temp directory as part of the setup.
For me the output is
Cell at Book2.xlsx!Sheet1!$A$2 has external workbook source of [Book1.xlsx]
It works by examining the LinkSources for a workbook and then sweeps through cells looking for that link source.
Option Explicit
'---------------------------------------------------------------------------------------
' Procedure : Investigate
' DateTime : 06/02/2018 14:40
' Author : Simon
' Purpose : Start execution here. There is some setup code
'---------------------------------------------------------------------------------------
' Arguments :
' arg1 : arg1 description
'
Sub Investigate()
'**************************************************
' START of Experiment setup code
'**************************************************
Dim wb1 As Excel.Workbook, wb2 As Excel.Workbook
GetOrCreateMyTwoWorbooks "Book1", "SimonSub1", wb1, "Book2", "SimonSub2", wb2
wb1.Worksheets(1).Range("a1").Formula = "=2^4"
wb2.Worksheets(1).Range("a1").Formula = "=2^2"
wb2.Worksheets(1).Range("b1").Formula = "=3^2"
wb2.Worksheets(1).Range("a2").FormulaR1C1 = "=[" & wb1.Name & "]Sheet1!R1C1/r1c1*r1c2"
'**************************************************
' END of Experiment setup code
'**************************************************
'**************************************************
'* now the real logic begins
'**************************************************
Dim dicLinkSources As Scripting.Dictionary
Set dicLinkSources = LinkSources(wb2)
'* get all the cells containing formulae in the worksheet we're interested in
Dim rngFormulaCells As Excel.Range
Set rngFormulaCells = wb2.Worksheets(1).UsedRange.SpecialCells(xlCellTypeFormulas)
'* set up results container (one could report as we find them but I like to collate)
Dim dicExternalWorksheetPrecedents As Scripting.Dictionary
Set dicExternalWorksheetPrecedents = New Scripting.Dictionary
'* loop throught the subset of cells on the worksheet that have formulae
Dim rngFormulaCellsLoop As Excel.Range
For Each rngFormulaCellsLoop In rngFormulaCells
Dim sFormula As String
sFormula = rngFormulaCellsLoop.Formula '* I like a copy in my locals window
'* search for all the link sources (experiment has only one, chance are you'll have many)
Dim vSearchLoop As Variant
For Each vSearchLoop In dicLinkSources.Items
If VBA.InStr(1, sFormula, vSearchLoop, vbTextCompare) > 0 Then
'* we found one, add to collated results
dicExternalWorksheetPrecedents.Add wb2.Name & "!" & wb2.Worksheets(1).Name & "!" & rngFormulaCellsLoop.Address, vSearchLoop
End If
Next vSearchLoop
Next
'*print collated results
Dim lResultLoop As Long
For lResultLoop = 0 To dicExternalWorksheetPrecedents.Count - 1
Debug.Print "Cell at " & dicExternalWorksheetPrecedents.Keys()(lResultLoop) & " has external workbook source of " & dicExternalWorksheetPrecedents.Items()(lResultLoop)
Next lResultLoop
Stop
End Sub
'---------------------------------------------------------------------------------------
' Procedure : LinkSources
' DateTime : 06/02/2018 14:38
' Author : Simon
' Purpose : To acquire list of link sources and more importantly the search term
' we're going to see to look for external workbooks
'---------------------------------------------------------------------------------------
' Arguments :
' [in] wb : The workbook we want report on
' [out,retval] : returns a dictionary with the lik sources in the keys and search term in item
'
Function LinkSources(ByVal wb As Excel.Workbook) As Scripting.Dictionary
Static fso As Object
If fso Is Nothing Then Set fso = VBA.CreateObject("Scripting.FileSystemObject")
Dim dicLinkSources As Scripting.Dictionary
Set dicLinkSources = New Scripting.Dictionary
Dim vLinks As Variant
vLinks = wb.LinkSources(XlLink.xlExcelLinks)
If Not IsEmpty(vLinks) Then
Dim lIndex As Long
For lIndex = LBound(vLinks) To UBound(vLinks)
Dim sSearchTerm As String
sSearchTerm = ""
If fso.FileExists(vLinks(lIndex)) Then
Dim fil As Scripting.file
Set fil = fso.GetFile(vLinks(lIndex))
'* this is what we'll search for in the cell formulae
sSearchTerm = "[" & fil.Name & "]"
End If
dicLinkSources.Add vLinks(lIndex), sSearchTerm
Next lIndex
End If
Set LinkSources = dicLinkSources
End Function
'*****************************************************************************************************************
' __ __
'_____ ______ ___________ ____________ _/ |_ __ __ ______ ______ _____/ |_ __ ________
'\__ \ \____ \\____ \__ \\_ __ \__ \\ __\ | \/ ___/ / ___// __ \ __\ | \____ \
' / __ \| |_> > |_> > __ \| | \// __ \| | | | /\___ \ \___ \\ ___/| | | | / |_> >
'(____ / __/| __(____ /__| (____ /__| |____//____ > /____ >\___ >__| |____/| __/
' \/|__| |__| \/ \/ \/ \/ \/ |__|
'
'*****************************************************************************************************************
'* this is just something to setup the experiment, you won't need this hence the big banner :)
'*
Public Sub GetOrCreateMyTwoWorbooks(ByVal sWbName1 As String, ByVal sSubDirectory1 As String, ByRef pwb1 As Excel.Workbook, _
ByVal sWbName2 As String, ByVal sSubDirectory2 As String, ByRef pwb2 As Excel.Workbook)
Static fso As Object
If fso Is Nothing Then Set fso = VBA.CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Set pwb1 = Application.Workbooks.Item(sWbName1)
Set pwb2 = Application.Workbooks.Item(sWbName2)
On Error GoTo 0
If pwb1 Is Nothing Then
Set pwb1 = Application.Workbooks.Add
Dim sSubDir1 As String
sSubDir1 = fso.BuildPath(Environ$("tmp"), sSubDirectory1)
If Not fso.FolderExists(sSubDir1) Then fso.CreateFolder (sSubDir1)
Dim sSavePath1 As String
sSavePath1 = fso.BuildPath(sSubDir1, sWbName1)
pwb1.SaveAs sSavePath1
End If
If pwb2 Is Nothing Then
Set pwb2 = Application.Workbooks.Add
Dim sSubDir2 As String
sSubDir2 = fso.BuildPath(Environ$("tmp"), sSubDirectory2)
If Not fso.FolderExists(sSubDir2) Then fso.CreateFolder (sSubDir2)
Dim sSavePath2 As String
sSavePath2 = fso.BuildPath(sSubDir2, sWbName2)
pwb2.SaveAs sSavePath2
End If
End Sub
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With