Max,
Your first suggestion was dead simple - thank you.
A question which springs from this is - can I take a list of named ranges,
such as that we have just created, and add it to and existing table of named
ranges in another spreadsheet?
Thank you & Regards
Ian Bull
One way:
Insert a new sheet
Click on A1
Click Insert>Name>Paste>Paste List
Another way which I found very useful:
Run J.E. McGimpsey's Sub ListNamesInWorkbook()
Link:
http://mcgimpsey.com/excel/listnames.html
Option Explicit
Public Sub ListNamesInWorkbook()
' by J.E. McGimpsey
' Thanks to Tom Ogilvy for help with overflow.
Const SHEETNAME As String = "Names in *"
Const ROWLIM As Long = 65500
Dim nameSht As Worksheet
Dim destRng As Range
Dim cell As Range
Dim wkSht As Worksheet
Dim shCnt As Long
Dim i As Long
Dim oldScreenUpdating As Boolean
With Application
oldScreenUpdating = .ScreenUpdating
.ScreenUpdating = False
End With
shCnt = 0
ListNamesAddSheet nameSht, shCnt
' list Workbook-level names
Set destRng = nameSht.Range("A5")
With destRng.Offset(-1, 0)
.Value = "Workbook-Level names"
.Font.Bold = True
End With
With ActiveWorkbook.Names
If .Count Then
destRng.Offset(0, 1).ListNames 'only workbook level
Set destRng = destRng.Offset(0, 1).End(xlDown).Offset(1, -1)
Else
destRng.Offset(0, 1).Value = "None"
Set destRng = destRng.Offset(0, 1)
End If
End With
With destRng.Resize(1, 3).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 5
End With
Set destRng = destRng.Offset(1, 0)
For Each wkSht In ActiveWorkbook.Worksheets
With destRng
.Value = "Names in sheet """ & wkSht.Name & """"
.Font.Bold = True
Set destRng = .Offset(1, 0)
End With
With wkSht.Names
If .Count Then
For i = 1 To .Count
With .Item(i)
destRng.Offset(0, 1) = Mid(.Name, InStr(.Name,
"!") + 1)
destRng.Offset(0, 2) = "'" & .RefersTo
Set destRng = destRng.Offset(1, 0)
If destRng.Row > ROWLIM Then
ListNamesAddSheet nameSht, shCnt
Set destRng = nameSht.Range("A5")
destRng.Offset(-1, 0).Value = _
"Names in sheet """ & wkSht.Name & """"
End If
End With
Next i
Else
destRng.Offset(0, 1).Value = "None"
Set destRng = destRng.Offset(1, 0)
End If
End With
With destRng.Resize(1, 4).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 5
End With
Set destRng = destRng.Offset(1, 0)
Next wkSht
With Application
.StatusBar = False
.ScreenUpdating = oldScreenUpdating
End With
End Sub
Private Sub ListNamesAddSheet( _
nameSht As Worksheet, shtCnt As Long)
Const SHEETNAME As String = "Names in "
Const SHEETTITLE As String = "Names in $ as of "
Const DATEFORMAT As String = "dd MMM yyyy hh:mm"
Dim shtName As String
With ActiveWorkbook
' Delete existing sheet and create new one
shtName = Left(SHEETNAME & .Name, 28)
shtCnt = shtCnt + 1
If shtCnt > 1 Then _
shtName = shtName & "_" & Format(shtCnt, "00")
On Error Resume Next
Application.DisplayAlerts = False
.Worksheets(shtName).Delete
Application.DisplayAlerts = True
On Error GoTo 0
Set nameSht = .Worksheets.Add( _
after:=Sheets(Sheets.Count))
End With
With nameSht
' Format headers
.Name = shtName
.Columns(1).ColumnWidth = 30
.Columns(2).ColumnWidth = 20
.Columns(3).ColumnWidth = 90
With .Range("B:C")
.Font.Size = 9
.HorizontalAlignment = xlLeft
.EntireColumn.WrapText = True
End With
With .Range("A1")
.Value = Application.Substitute(SHEETTITLE, "$", _
ActiveWorkbook.Name) & Format(Now, DATEFORMAT)
With .Font
.Bold = True
.ColorIndex = 5
.Size = 14
End With
End With
With .Range("A3").Resize(1, 3)
.Value = Array("Sheet", "Name", "Refers To")
With .Font
.ColorIndex = 13
.Bold = True
.Size = 12
End With
.HorizontalAlignment = xlCenter
With .Borders(xlEdgeBottom)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = 5
End With
End With
End With
End Sub
-------------------------------
