Excel Ctrl Tilde To Show Named Range

Modified to test the validity

Sub ShowNamedRange()
Dim nm As Name
Dim myName As String
Dim shp As Shape
Dim blnShowing As Boolean
Dim l&, t&, w&, h&

For Each shp In ActiveSheet.Shapes
    If Left(shp.Name, Len("Named Range")) = "Named Range" Then
        shp.Delete
        blnShowing = True
    End If
Next

If blnShowing = False Then
    For Each nm In ActiveWorkbook.Names
        On Error Resume Next
        myName = ""
        myName = nm.RefersToRange.Parent.Name
        On Error GoTo 0
        If Len(myName) Then
            If nm.RefersToRange.Parent.Name = ActiveSheet.Name Then
                With nm.RefersToRange
                    l = .Left
                    t = .Top
                    w = .Width
                    h = .Height
                End With
            
                With ActiveSheet.Shapes.AddShape(msoShapeRectangle, l, t, w, h)
                    .Name = "Named Range " & nm.Name
                    .Fill.ForeColor.RGB = RGB(80, 240, 180)
                   .TextFrame.Characters.Text = nm.Name
                    .TextFrame.Characters.Font.ColorIndex = 1
                End With
            End If
        End If
    Next nm
End If
End Sub