Create Named Range for Each Sheet, Store those Named Ranges in a list or array, and then Delete the-CodePudding

I have a fairly unique situation that I hope to solve with a series of macros. I regularly work with large workbooks (>100 tabs), for which I would like to be able to navigate between sheets quickly while in cell edit mode. This is obviously challenging, as cell edit mode seems to block most VBA code. I have found a solution to this, which is to create a named range in cell a1 on each sheet in the workbook.

The next goal is to store these named ranges in a list, sheet, or an array, so that later on I can run another macro that will leverage this list/sheet/array to delete all of those named ranges located in cell a1 on each sheet. Understandably, this is likely a roundabout problem that can be solved in various ways, many of those much simpler. However, due to the nature of my work, this seems to be the most straight-forward solution. Below I will detail the code that I have written, for the 3 parts (likely 3 separate macros).

First macro (create named ranges)

Sub NamedRange()
    Application.ScreenUpdating = False
    Dim ws As Worksheet
    Dim rng As Range
        For Each ws In ActiveWorkbook.Worksheets
        ws.Activate
        With ActiveWindow
            Set rng = ws.Range("A1")
            ActiveWorkbook.names.Add Name:=Replace(ws.Name, " ", "_"), RefersTo:=rng
        End With
    Next
Application.ScreenUpdating = True
End Sub

Second macro (store named ranges. I opted to store them in a new sheet that will also be deleted with the named ranges, but if this can be done in an array or list, that would be better)

Sub ListSheets()

Dim ws As Worksheet
Dim x As Integer

Sheets.Add(After:=Sheets(Sheets.Count)).Name = "namedranges"

x = 1

Sheets("namedranges").Range("A:A").Clear

For Each ws In Worksheets
     Sheets("namedranges").Cells(x, 1) = ws.Name
     x = x   1
Next ws

End Sub

Third macro (delete named ranges, this is the only one that does not work at all, the others are functional - albeit inefficient)

Sub DeleteNamedRanges()
    Dim strArray() As String
    Dim TotalRows As Long
    Dim i As Long
    Dim strName As Variant

    TotalRows = Rows(Rows.Count).End(xlUp).Row
    ReDim strArray(1 To TotalRows)

    For i = 1 To TotalRows
        strArray(i) = Cells(i, 1).Value
    Next
   i = strName
   For Each strName In strArray
        strName.Delete
    Next

End Sub

Any help is much appreciated, I've been struggling with this issue for a while and it would be a huge help to get this rolling. If I can provide any additional color, I am happy to follow up, once again, thanks so much!

CodePudding user response：

You should not write the names to the workbook but to each sheet:

Option Explicit
Const CheckName  As String = "RememberMe"
Sub DoNames()
Dim g As Worksheet
DeleteNames
For Each g In Worksheets
    g.Names.Add CheckName, g.Range("a1")
    
Next g
' Example: Now you can get every name by sheet:
For Each g In Worksheets
Debug.Print g.Names(CheckName).RefersToRange.Address
Next

' Your Code
DeleteNames
End Sub

Sub DeleteNames()
Dim g As Worksheet
On Error Resume Next ' Lazy but ok here
For Each g In Worksheets
g.Names(CheckName).Delete
    Next g
End Sub

CodePudding user response：

A solution on Workbooknames?

Option Explicit
Sub DoNames()
Dim g As Worksheet
DeleteNames
For Each g In Worksheets
 ActiveWorkbook.Names.Add g.Name & "_todel", Range("a1")
Next g
End Sub

Sub DeleteNames()
Dim n As Name
On Error Resume Next ' Lazy but ok here
For Each n In ActiveWorkbook.Names
If n.Name Like "*_todel" Then n.Delete
Next
End Sub