'==================================================================================
'- SHOW RANGE NAMES IN WORKBOOK & WORKSHEETS (DOES NOT SHOW NAMES IN CHARTS)
'- SUBROUTINE TO DEAL WITH #REF! ERRORS
'- An Excel Range Name is a 'Name Object' with its own set of properties.
'- Can be set at WorkBook or WorkSheet level (so allowing duplicate names)
'- Brian Baulsom July 2007
'==================================================================================
Dim MasterList As Worksheet ' worksheet with correct list of names
Dim wb As Workbook ' checks the Active Workbook
Dim ws As Worksheet ' checks all sheets
Dim Nm As Name ' Name object
Dim NmRefers As String
Dim ToSheet As Worksheet
Dim ToRow As Long
Dim TotalNames As Integer
'-
Dim MyLocation As String
Dim MyName As String
Dim MyRefersTo As String
'-----------------------------------------------------------------------------------
'===================================================================================
'- MAIN ROUTINE
'===================================================================================
Sub SHOW_NAMES()
On Error Resume Next ' ignore errors
Application.Calculation = xlCalculationManual
Set wb = ActiveWorkbook
Set MasterList = ThisWorkbook.Worksheets("MasterList")
'-------------------------------------------------------------------------------
'- calculate total names in workbook (used to show status)
TotalNames = wb.Names.Count
For Each ws In Worksheets
TotalNames = TotalNames + ws.Names.Count
Next
'-------------------------------------------------------------------------------
'- MAKE NEW WORKSHEET FOR RESULTS
Set ToSheet = Worksheets.Add
ToSheet.Cells.ClearContents
With ToSheet.Range("A1:D1")
.Value = Array("Location", "Name", "RefersTo", "Value")
.Font.Bold = True
.Interior.ColorIndex = 6
End With
ToRow = 2
'--------------------------------------------------------------------------------
'- WORKBOOK NAMES
If wb.Names.Count > 0 Then
For Each Nm In wb.Names
Application.StatusBar = ToRow & "/" & TotalNames ' show progress
Nm.Visible = True
'------------------------------------------------------------------------
'- record data
MyLocation = wb.Name
MyName = Nm.Name
MyRefersTo = Nm.RefersTo
'-
ToSheet.Cells(ToRow, 1).Value = MyLocation
ToSheet.Cells(ToRow, 2).Value = MyName
ToSheet.Cells(ToRow, 3).Value = "'" & MyRefersTo 'FORCE TO TEXT
ToSheet.Cells(ToRow, 4).Value = Evaluate(Nm.RefersTo)
'-------------------------------------------------------------------------
'- REF error
If InStr(1, CStr(Nm.RefersTo), "#REF", vbTextCompare) > 0 Then
ToSheet.Range(Cells(ToRow, 1), Cells(ToRow, 4)).Interior.ColorIndex = 6
CheckREFerror ' CALL SUBROUTINE
End If
'-------------------------------------------------------------------------
'- next name
ToRow = ToRow + 1
Next
End If
'---------------------------------------------------------------------------------
'- WORKSHEET NAMES
For Each ws In wb.Worksheets
If ws.Names.Count > 0 Then
For Each Nm In ws.Names
Application.StatusBar = ToRow & "/" & TotalNames 'show progress
Nm.Visible = True
'------------------------------------------------------------------------
'- record data
MyLocation = ws.Name
MyName = Nm.Name
MyRefersTo = Nm.RefersTo
'-
ToSheet.Cells(ToRow, 1).Value = MyLocation
ToSheet.Cells(ToRow, 2).Value = MyName
ToSheet.Cells(ToRow, 3).Value = "'" & MyRefersTo 'FORCE TO TEXT
ToSheet.Cells(ToRow, 4).Value = Evaluate(Nm.RefersTo)
'-------------------------------------------------------------------------
'- REF error
If InStr(1, CStr(Nm.RefersTo), "#REF", vbTextCompare) > 0 Then
ToSheet.Range(Cells(ToRow, 1), Cells(ToRow, 4)).Interior.ColorIndex = 6
CheckREFerror ' CALL SUBROUTINE
End If
'---------------------------------------------------------------------
'- next name
ToRow = ToRow + 1
Next
End If
Next
'---------------------------------------------------------------------------------
ToSheet.UsedRange.Columns.AutoFit
MsgBox ("Done")
Application.StatusBar = False
Application.Calculation = xlCalculationAutomatic
End Sub
'=============== END OF PROCEDURE ====================================================
'=====================================================================================
'- SUBROUTINE : CALLED FROM ABOVE TO DEAL WITH "#REF!"
'- Here the name is deleted
'=====================================================================================
Private Sub CheckREFerror()
Dim msg As String
Dim rsp
'--------------------------------------------------------------------------------
msg = "DELETE NAME WITH #REF! ERROR ?" & vbCr & vbCr _
& "Location : " & MyLocation & vbCr _
& "Name :" & MyName & vbCr _
& "RefersTo : " & MyRefersTo
rsp = MsgBox(msg, vbYesNoCancel + vbQuestion, "#REF! ERROR")
'---------------------------------------------------------------------------------
Select Case rsp
Case vbCancel
End
Case vbYes
Nm.Delete
End Select
'---------------------------------------------------------------------------------
End Sub
'=====================================================================================
