Col Delane
Active Member
- Joined
- Jan 14, 2014
- Messages
- 304
In doing some diagnostics on a very large financial model (160Mb) for a client, as part of the "mapping" exercise to get a handle on what the model actually did, I had a need to identify which sheets in the workbook were linked to other sheets, and how many such links there were. Unfortunately, Find only provides a count of the number of CELLS that contain a specified string rather than a count of the number of separate occurrences (e.g. where there are more than one reference to another sheet within the same formulae)
As a result, I developed the following code to loop through all cells containing formulae in each worksheet of the active workbook to ascertain the number of individual occurrences of a each other sheet-name within the formulae on the sheet (i.e. No. of DIRECT intersheet links - so does NOT include links to Defined Names that in turn link to another sheet) and records the results in a matrix, by precedent and dependent sheet, in a new sheet.
I thought others may find app. this useful, so offer it as a pay back for all the help I received from this Forum over the last decade which has helped me get to the level of being able to develop this app.
Any comments, suggestions for improvement, etc. will be greatly appreciated.
As a result, I developed the following code to loop through all cells containing formulae in each worksheet of the active workbook to ascertain the number of individual occurrences of a each other sheet-name within the formulae on the sheet (i.e. No. of DIRECT intersheet links - so does NOT include links to Defined Names that in turn link to another sheet) and records the results in a matrix, by precedent and dependent sheet, in a new sheet.
I thought others may find app. this useful, so offer it as a pay back for all the help I received from this Forum over the last decade which has helped me get to the level of being able to develop this app.
Any comments, suggestions for improvement, etc. will be greatly appreciated.
Code:
Sub SheetLink_Count()
' Date: 20/01/2014
' Action: Added
' Author: Colin Delane, CA & Financial Analyst/Modeller, Perth, Western Australia
' Purpose: The following code loops through all cells containing formulae in each worksheet of the active workbook to ascertain
' the number of individual occurrences (NOT cells) of a each other sheet-name within the formulae on the sheet
' (i.e. No. of [U]DIRECT [/U]intersheet links - so does NOT include links to Defined Names that in turn link to another sheet) and
' records the results in a matrix, by precedent and dependent sheet, in a new sheet.
'---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
' Dimension Variables
Dim wbk As Workbook
Dim wksDep As Worksheet
Dim wksPrec As Worksheet
Dim wksRpt As Worksheet
Dim rngSearch As Range
Dim rngC As Range
Dim intRow As Integer
Dim intCol As Integer
Dim ipbResp As Variant
Dim strLink As String
Dim strMsg As String
Dim lngLinkCount1 As Long
Dim lngLinkCount2 As Long
Dim lngLinkCount3 As Long
Dim iTimeStart As Double
Dim Response1
iTimeStart = VBA.Timer
On Error Resume Next
Set wbk = ActiveWorkbook
' Add sheet
Application.Worksheets.Add
ActiveSheet.Name = "Internal Link Count"
Set wksRpt = ActiveSheet
' Set counters
intRow = 3 ' First blank row
intCol = 2 ' First blank column
' Create table headings:
' Dependent Worksheet Names
For Each wksDep In ActiveWorkbook.Worksheets
wksRpt.Cells(intRow, 1).Value = wksDep.Name
intRow = intRow + 1
Next wksDep
With Columns("A:A")
.EntireColumn.HorizontalAlignment = xlLeft
.EntireColumn.AutoFit
End With
' Precedent Worksheet Names
For Each wksPrec In ActiveWorkbook.Worksheets
With wksRpt.Cells(2, intCol)
.Value = wksPrec.Name
.BorderAround (xlContinuous)
End With
intCol = intCol + 1
Next wksPrec
With Range(Cells(2, 2), Cells(2, intCol))
.Font.Bold = True
.WrapText = True
.VerticalAlignment = xlTop
.EntireColumn.HorizontalAlignment = xlCenter
.EntireColumn.ColumnWidth = 15
End With
' Add headings
With Range("A1")
.Value = "As at: " & Format(Date, "dd-mmm-yyyy")
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
With Range("B1")
.Value = "Precedent Sheets >>"
.Font.Bold = True
.HorizontalAlignment = xlLeft
End With
With Range("A2")
.Value = "Dependent Sheet"
.Font.Bold = True
.HorizontalAlignment = xlLeft
.BorderAround (xlContinuous)
End With
' Freeze Panes
Range("B3").Select
ActiveWindow.FreezePanes = True
' Enter formulae to sum No. of links in dependent worksheets (by row)
With Range("A2").Offset(0, intCol - 1)
.Value = "Total"
.BorderAround (xlContinuous)
End With
With Range("A2").Offset(1, intCol - 1)
.FormulaR1C1 = "=SUM(RC[-" & intCol - 2 & "]:RC[-1])"
.NumberFormat = "#,##0_);(#,##0); ""- """
.EntireColumn.HorizontalAlignment = xlCenter
End With
Range("A2").Offset(1, intCol - 1).Copy
Range(Range("A2").Offset(2, intCol - 1), Cells(intRow - 1, intCol)).PasteSpecial xlPasteFormulasAndNumberFormats
' Build bottom fences & column totals
With Range("A2").Offset(intRow - 2, 0)
.FormulaR1C1 = "\-"
.Copy Range(Range("A2").Offset(intRow - 2, 1), Cells(intRow, intCol))
End With
With Range("A2").Offset(intRow - 1, 0)
.Value = "Total"
.Font.Bold = True
.HorizontalAlignment = xlLeft
End With
With Range("A2").Offset(intRow - 1, 1)
.FormulaR1C1 = "=SUM(R[-" & intRow - 1 & "]C:R[-1]C)"
.NumberFormat = "#,##0_);(#,##0); ""- """
.Copy Range(Range("A2").Offset(intRow - 1, 2), Cells(intRow + 1, intCol))
End With
With Range("A2").Offset(intRow, 0)
.FormulaR1C1 = "\="
.Copy Range(Range("A2").Offset(intRow, 1), Cells(intRow + 2, intCol))
End With
' Set/Reset counters
intRow = 3
intCol = 2
lngLinkCount1 = 0
lngLinkCount2 = 0
lngLinkCount3 = 0
' Loop thru all worksheets
For Each wksDep In ActiveWorkbook.Worksheets
On Error GoTo ErrHandler
' Define range to search
Set rngSearch = wksDep.UsedRange.SpecialCells(xlCellTypeFormulas)
' Loop thru each precedent worksheet
For Each wksPrec In ActiveWorkbook.Worksheets
strLink = wksPrec.Name
' Loop thru all cells in the UsedRange of the dependent worksheet (wksDep)
For Each rngC In rngSearch
' See if strLink occurs in rngC, & if so, count the occurrences
lngLinkCount1 = (Len(rngC.Formula) - Len(Replace(LCase(rngC.Formula), LCase(strLink), ""))) / Len(strLink)
' Link occurrence counter
If lngLinkCount1 > 0 Then 'Block IF #1
' Add 1 to total
lngLinkCount2 = lngLinkCount2 + lngLinkCount1
End If 'Block IF #1
' Reset link counter ready for search of next cell
lngLinkCount1 = 0
Next rngC
' Capture total LINK COUNT for each wksDep/wksPrec combination
With wksRpt.Cells(intRow, intCol)
.Value = lngLinkCount2
.NumberFormat = "#,##0_);(#,##0); ""- """
End With
' Update/reset counters
' Update grand total counter for links
lngLinkCount3 = lngLinkCount3 + lngLinkCount2
' Reset link & column counter ready for next precedent sheet search
lngLinkCount2 = 0
intCol = intCol + 1
Next wksPrec
'Update / reset counters
intRow = intRow + 1
intCol = 2
lngLinkCount1 = 0
lngLinkCount2 = 0
Beep
Beep
Response1 = MsgBox("Continue?", vbYesNo)
If Response1 = vbNo Then Exit Sub
ErrHandler:
Resume Next
Next wksDep
If lngLinkCount3 = 0 Then wksRpt.Delete
MsgBox "Search complete." & vbLf & vbLf & lngLinkCount3 & " links found (see Internal Link Count sheet for details)." & vbLf & vbLf & "Time taken: " & VBA.Timer - iTimeStart & " seconds."
End Sub
