Delete Name Ranges by Scope VBA

[Admin]

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

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

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