Need Macro to delete all names but keep Print_Areas

[jmarg]

Hi- I need to delete all name ranges in Name Manager except for the Print_Areas but i need to do it in small batched due to the sheet not opening up. THis code runs but it still deletes all names. What am I missing?

Sub DeleteDeadNames2()
Dim nName As Name
Dim lCount As Long

With ActiveWorkbook
For lCount = .Names.Count To 1 Step -1
If lCount Mod 1000 = 0 Then
Debug.Print lCount
.Save
DoEvents
End If
If Right(.Names(lCount), 11) <> "!Print_Area" And .Names(lCount) <> "Print_Area" Then
.Names(lCount).delete
End If
Next lCount
End With
End Sub

 

[johnnyL]

Sub DeleteDeadNames3()
    Dim NameToRemove As Name
'
    For Each NameToRemove In ActiveWorkbook.Names
        If Right(NameToRemove.Name, 11) <> "!Print_Area" And NameToRemove.Name <> "Print_Area" Then
            NameToRemove.Delete
        End If
    Next NameToRemove
End Sub

 

[jmarg]

Sub DeleteDeadNames3()
    Dim NameToRemove As Name
'
    For Each NameToRemove In ActiveWorkbook.Names
        If Right(NameToRemove.Name, 11) <> "!Print_Area" And NameToRemove.Name <> "Print_Area" Then
            NameToRemove.Delete
        End If
    Next NameToRemove
End Sub

This code still deleted the Print_Areas.. Additionally it removes my batch coding

"For lCount = .Names.Count To 1 Step -1
If lCount Mod 1000 = 0 Then.."

*Due to way too many names this has to run in batches or it won't run at all.

 

[johnnyL]

What do you mean 'it won't run at all'? It does nothing, like you never even executed it, or do you mean something else?

 

[jmarg]

What do you mean 'it won't run at all'? It does nothing, like you never even executed it, or do you mean something else?

If I don't run it in batches of 1000 or less it gives me the loading icon but ultimately will never run (I've waited 3+ hours). So my code above gets progressively faster as the names are deleted in batches, but it still is deleting the "Print_Area" of any set print areas.

 

[Sequoyah]

Hi, try this

Sub DeleteDeadNames2()
    
    Dim nName As Name
    Dim lCount As Long
    
    With ActiveWorkbook
        For lCount = .Names.Count To 1 Step -1
            If lCount Mod 1000 = 0 Then
                Debug.Print lCount
                .Save
                DoEvents
            End If
            If Not .Names(lCount).Name Like "*Print_Area" Then
                .Names(lCount).Delete
            End If
        Next lCount
    End With
End Sub

 

[johnnyL]

If I don't run it in batches of 1000 or less it gives me the loading icon but ultimately will never run (I've waited 3+ hours). So my code above gets progressively faster as the names are deleted in batches, but it still is deleting the "Print_Area" of any set print areas.

How long does your code with batching take to run?

 

[jmarg]

How long does your code with batching take to run?

30 min or so

 

[johnnyL]

30 min or so

30 minutes? Dang!!!

Ok try this and see how long it takes:

Sub DeleteDeadNames3v2()
    Dim NameToRemove As Name
'
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Application.EnableEvents = False
'
    For Each NameToRemove In ActiveWorkbook.Names
        If Right(NameToRemove.Name, 11) <> "!Print_Area" And NameToRemove.Name <> "Print_Area" Then
            NameToRemove.Delete
        End If
    Next NameToRemove
'
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub