Sub DeleteOptionForRangeNames()
Dim i As Integer
Application.ScreenUpdating = False
On Error Resume Next
i = ActiveWorkbook.Names.Count
For x = i To 1 Step -1
Msg = "Do you want to Delete Named Range" & vbCrLf _
& ActiveWorkbook.Names(x).Name & "?" & vbCrLf _
& "" & vbCrLf _
& "With Reference to:" & vbCrLf _
& ActiveWorkbook.Names(x).RefersToR1C1
Ans = MsgBox(Msg, vbYesNo + vbQuestion, "Delete Named Range?")
If Ans = vbYes Then ActiveWorkbook.Names(x).Delete
Next x
Sheets(ShtName).Activate
Application.ScreenUpdating = True
End Sub
Code:Sub DeleteOptionForRangeNames() Dim i As Integer Application.ScreenUpdating = False On Error Resume Next i = ActiveWorkbook.Names.Count For x = i To 1 Step -1 Msg = "Do you want to Delete Named Range" & vbCrLf _ & ActiveWorkbook.Names(x).Name & "?" & vbCrLf _ & "" & vbCrLf _ & "With Reference to:" & vbCrLf _ & ActiveWorkbook.Names(x).RefersToR1C1 Ans = MsgBox(Msg, vbYesNo + vbQuestion, "Delete Named Range?") If Ans = vbYes Then ActiveWorkbook.Names(x).Delete Next x Sheets(ShtName).Activate Application.ScreenUpdating = True End Sub
Sub ListRangeNames()
Dim i As Integer, Temp As String, ShtName As String
ShtName = ActiveSheet.Name
Application.ScreenUpdating = False
On Error Resume Next
Sheets.Add.Name = "Temp"
i = ActiveWorkbook.Names.Count
For x = i To 1 Step -1
Sheets("Temp").[A65536].End(xlUp)(2, 1).Value = ActiveWorkbook.Names(x).Name
Sheets("Temp").[B65536].End(xlUp)(2, 1).Value = "'" & ActiveWorkbook.Names(x).RefersToR1C1
ActiveWorkbook.Names(x).Delete
Next x
Sheets(ShtName).Activate
Application.ScreenUpdating = True
End Sub
Sub RenameThem()
Dim Rng1 As Range
Dim Rng2 As Range
Dim c As Range
Dim Var2 As Range
Sheets("Temp").Select
Set Rng1 = Range("A1:A" & Range("A65536").End(xlUp).Row)
For Each c In Rng1
Var2 = c.Offset(, 1).Value
Var2 = Right(Var2, Len(Var2))
ActiveWorkbook.Names.Add Name:=c, RefersToR1C1:=Var2
Next c
End Sub
This code will list all your Named Ranges on a worksheet named "Temp".
Code:
This code will also delete each named range.Code:Sub ListRangeNames() Dim i As Integer, Temp As String, ShtName As String ShtName = ActiveSheet.Name Application.ScreenUpdating = False On Error Resume Next Sheets.Add.Name = "Temp" i = ActiveWorkbook.Names.Count For x = i To 1 Step -1 Sheets("Temp").[A65536].End(xlUp)(2, 1).Value = ActiveWorkbook.Names(x).Name Sheets("Temp").[B65536].End(xlUp)(2, 1).Value = "'" & ActiveWorkbook.Names(x).RefersToR1C1 ActiveWorkbook.Names(x).Delete Next x Sheets(ShtName).Activate Application.ScreenUpdating = True End Sub
The next code will rebuild each named range from the Temp page.
Code:Sub RenameThem() Dim Rng1 As Range Dim Rng2 As Range Dim c As Range Dim Var2 As Range Sheets("Temp").Select Set Rng1 = Range("A1:A" & Range("A65536").End(xlUp).Row) For Each c In Rng1 Var2 = c.Offset(, 1).Value Var2 = Right(Var2, Len(Var2)) ActiveWorkbook.Names.Add Name:=c, RefersToR1C1:=Var2 Next c End Sub
Edit the Temp page first and then rebuild your Named Ranges using the "RenameThem" code.
Sub DeleteNamedRangesExcept()
For Each wn In ActiveWorkbook.Names
Select Case wn.Name
Case Is = "WedSups", "NotNeeded", "Clients"
Case Else
wn.Delete
End Select
Next wn
End Sub