Delete Name Ranges by Scope VBA

Hi All,


Here is a workaround which allows you to delete the name ranges from a workbook where both the scope exists of same name

Code:

---

Option Explicit
Public Enum NameScope
    xlWorkbook = 0
    xlWorksheet = 1
End Enum
Sub DeleteNamedRanges(ByRef Wbk As Workbook, ScopeLevel As NameScope)
   
    '// Developed by    : Krishnakumar @ ExcelFox.com
   
    Dim lngLoop    As Long
    Dim lngIndex    As Long
    Dim strName    As String
    Dim wksTemp    As Worksheet
    Dim lngSU      As Long
    Dim lngCalc    As Long
    Dim lngEE      As Long
    Dim lngDA      As Long
   
   
    With Application
        lngSU = .ScreenUpdating
        lngCalc = .Calculation
        lngDA = .DisplayAlerts
        lngEE = .EnableEvents
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .DisplayAlerts = False
        .EnableEvents = False
    End With
   
    Set wksTemp = Wbk.Worksheets.Add
   
    With Wbk
        For lngLoop = .Names.Count To 1 Step -1
            If ScopeLevel = xlWorksheet Then
                If TypeOf .Names(lngLoop).Parent Is Worksheet Then
                    strName = Split(.Names(lngLoop).Name, "!")(1)
                    If GLOBALLYEXISTS(Wbk, strName) Then
                        .Names(lngLoop).Delete
                    End If
                End If
            ElseIf ScopeLevel = xlWorkbook Then
                If TypeOf .Names(lngLoop).Parent Is Workbook Then
                    strName = "!" & .Names(lngLoop).Name
                    If LOCALLYEXISTS(Wbk, strName) Then
                        .Names(lngLoop).Delete
                    End If
                End If
            End If
        Next
    End With
   
    wksTemp.Delete
   
    With Application
        .ScreenUpdating = lngSU
        .Calculation = lngCalc
        .DisplayAlerts = lngDA
        .EnableEvents = lngEE
    End With

End Sub
Private Function GLOBALLYEXISTS(ByRef Wbk As Workbook, ByVal NameName As String) As Boolean
   
    Dim lngLoop    As Long
    Dim lngSU      As Long
   
    With Application
        lngSU = .ScreenUpdating
        .ScreenUpdating = False
    End With
   
    With Wbk
        For lngLoop = .Names.Count To 1 Step -1
            If .Names(lngLoop).Name = NameName Then
                If TypeOf .Names(lngLoop).Parent Is Workbook Then
                    GLOBALLYEXISTS = True
                    GoTo Xit
                End If
            End If
        Next
    End With
Xit:
    Application.ScreenUpdating = lngSU
   
End Function
Private Function LOCALLYEXISTS(ByRef Wbk As Workbook, ByVal NameName As String) As Boolean
   
    Dim lngLoop    As Long
    Dim lngSU      As Long
   
    With Application
        lngSU = .ScreenUpdating
        .ScreenUpdating = False
    End With
   
    With Wbk
        For lngLoop = .Names.Count To 1 Step -1
            If .Names(lngLoop).Name Like "*" & NameName Then
                If TypeOf .Names(lngLoop).Parent Is Worksheet Then
                    LOCALLYEXISTS = True
                    GoTo Xit
                End If
            End If
        Next
    End With
Xit:
    Application.ScreenUpdating = lngSU
   
End Function

---

and call the procedure as

Code:

---

Sub kTest()
       
    'Delete Local Names where both the scope exists (Local and Global)
    DeleteNamedRanges ThisWorkbook, xlWorksheet
   
    'Delete Global Names where both the scope exists (Local and Global)
    'DeleteNamedRanges ThisWorkbook, xlWorkbook
   
End Sub

---