Add dynamic ranges names to any worksheet
May 11, 2009 • JP • 6 Comments • Rate This Article
• Links to this article
I was looking for a way to create dynamic range names quickly, and came across this page from Contextures:
Create Dynamic Ranges With a Macro
Personally I prefer the standard OFFSET formula for creating dynamic named ranges. I'm used to it, so I don't mind the performance hit (if any). So I wrote this macro to take the column headers from a worksheet, and create dynamic named ranges for each one. It assumes that your data is in a contiguous range starting in cell A1 (with your headers in row 1).
First we try to guess the header row, by counting the number of columns and then using the Range.End method to find the rightmost end of the header range. The ColLetter function was taken from Column Numbers To Letters as it returns the column letter needed for both the header range and the dynamic formula.
' inspired by http://www.contextures.com/xlNames03.html
' assumes starting column is A
' get header range
Dim rngHeader As Excel.Range
Dim lastColumnLetter As String
lastColumnLetter = ColLetter(Columns.Count)
Set rngHeader = Range(Range("A1"), Range(lastColumnLetter & "1").End(xlToLeft))
Dim wkshtName As String
wkshtName = ActiveWorkbook.Sheets(1).Name
Dim i As Long
Dim rngName As String
Dim rngAddr As String
Dim columnLetter As String
' loop through header cells, create dynamic OFFSET named range
For i = 1 To rngHeader.Count
rngAddr = rngHeader.Cells(i).Address
' get column letter from number
columnLetter = ColLetter(rngHeader.Columns(i).Column)
' get column header to use as range name
' if header contains spaces, remove them
rngName = Replace(rngHeader.Cells(i), " ", "_")
ActiveWorkbook.Names.Add Name:=rngName, RefersTo:= _
"=OFFSET(" & wkshtName & "!" & rngAddr & ",1,0,COUNTA(" & wkshtName & "!$" & _
columnLetter & ":$" & columnLetter & ")-1,1)"
Next i
End Sub
Function ColLetter(ColNumber As Long) As String
' from a comment on dailydoseofexcel.com
ColLetter = Application.Substitute _
(Cells(1, ColNumber).Address(False, False), "1", "")
End Function
To construct the OFFSET formula, I simply listed the original formula
=OFFSET(Sheet1!$A$1,1,0,COUNTA(Sheet1!$A:$A)-1,1)
and substituted the variables I created for the appropriate parameters.
↑ Scroll to topPrevious Post: Setting default function parameters
Next Post: Site maintenance and upgrade




That is truly awesome code!
The biggest drawback I have seen from creating the dynamic ranges is the manualness of the whole process!
Now I just click a macro and it is done!
Thanks,
Chuck
Very Nice. I only recently tried to create a simple appraoch to dynamic naming. Here is my effort. I try to use the exisiting header and remove special charcters not supported by naming. Jimmy your code is much more immaculate than mine.
On Error Resume Next
Dim sRangeName As String
Dim n As Name
Dim dName As String
If ActiveWorkbook Is Nothing Then Exit Sub
dName = ActiveSheet.Name & "_" & ActiveCell.Value
dName = Replace(dName, " ", "_")
dName = Replace(dName, "&", "")
dName = Replace(dName, "$", "")
dName = Replace(dName, "%", "")
dName = Replace(dName, "-", "")
dName = Replace(dName, "(", "")
dName = Replace(dName, ")", "")
sRangeName = InputBox("Enter a range name, then push OK. ", _
"Add Vertical Dynamic Range", dName)
If sRangeName = "" Then Exit Sub
sRangeName = Replace(sRangeName, " ", "_")
ActiveWorkbook.Names.Add Name:=sRangeName, _
RefersTo:="=OFFSET(" & ActiveCell.Address & ",0,0,COUNTA(" & Columns(ActiveCell.Column).Address & "),1)"
For Each n In ActiveWorkbook.Names
If n.Name = sRangeName Then Exit Sub
Next n
MsgBox Err.Description, , "Invalid Name"
On Error GoTo 0
End Sub
Sub BlockVerticalRangeNames()
Dim MyCell As Range
Dim Col As Integer
Dim StartVal As Integer
Dim StopVal As Integer
Set MyCell = Application.InputBox("Select upper Left Most Cell for Vertical Ranges", , , , , , , 8)
MyCell.Activate
StartVal = MyCell.Columns.Count
StopVal = Range(MyCell, MyCell.End(xlToRight)).Columns.Count
For Col = 0 To StopVal - 1
If ActiveCell = "" Then Exit Sub
Call AddDynamicRangeVertical
ActiveCell.Offset(0, 1).Select
Next Col
End Sub
I just realized that if your sheet name has spaces in it, the code will fail. The way around it is to simply wrap the worksheet name in single quotes, like this:
"=OFFSET('" & wkshtName & "'!" & rngAddr & ",1,0,COUNTA('" & wkshtName & "'!$" & _
columnLetter & ":$" & columnLetter & ")-1,1)"
If the sheet name doesn't have spaces, Excel just ignores the single quotes.
Great macro!
You may add worksheet name to name range (ie Sheet1_HeaderName) by just change
wkshtName = Replace(ActiveWorkbook.ActiveSheet.Name, " ", "")
and
ActiveWorkbook.Names.Add Name:=wkshtName & "_" & rngName, RefersTo:= _
"=OFFSET(" & wkshtName & "!" & rngAddr & ",1,0,COUNTA(" & wkshtName & "!$" & _
columnLetter & ":$" & columnLetter & ")-1,1)"
Another hint to delete "phanton" name range of non continuous columns is to add at the end of the macro this:
ActiveWorkbook.Names(wkshtName & "_").Delete
I think that a correct syntax is:
"=OFFSET('" & ActiveWorkbook.ActiveSheet.Name & "'!" & rngAddr & ",1,0,COUNTA('" & ActiveWorkbook.ActiveSheet.Name & "'!$" & _
columnLetter & ":$" & columnLetter & ")-1,1)"
Just modified your code a wee bit to make it dynamically name any range based on a selection, also giving the user to select the column for making the COUNTA work on a column of choice whilst also adding a flexibity to naming the range….. Tks. Only drawback is the range selected to be name should have the top active cell as the name desired cell
' inspired by http://www.contextures.com/xlNames03.html
' assumes starting column is A
' get header range
Dim whichcol As String
Dim rngHeader As Excel.Range
Dim lastColumnLetter As String
lastColumnLetter = ColLetter(Columns.Count)
Set rngHeader = Selection
Dim wkshtName As String
wkshtName = ActiveSheet.Name
Dim i As Long
Dim rngName As String
Dim rngAddr As String
Dim columnLetter As String
' loop through header cells, create dynamic OFFSET named range
For i = 1 To Selection.Columns.Count
rngAddr = rngHeader.Cells(i).Address
' get column letter from number
columnLetter = ColLetter(rngHeader.Columns(i).Column)
' get column header to use as range name
' if header contains spaces, remove them
rngName = InputBox(Prompt:="Click Cancel to Name the Range as Selected Cell", Title:="Name the Range")
If rngName = "" Then rngName = Replace(rngHeader.Cells(i), " ", "_")
whichcol = InputBox("Which Column to Count", Title:="Dynamic Range Name")
If whichcol = "" Then
MsgBox "No Name As Been Created"
Exit Sub
End If
ActiveWorkbook.Names.Add Name:=rngName, RefersTo:= _
"=OFFSET(" & wkshtName & "!" & rngAddr & ",1,0,COUNTA(" & wkshtName & "!$" & _
whichcol & "$" & ActiveCell.Row & ":$" & whichcol & "$" & ActiveSheet.Rows.Count & ")-1,1)"
Next i
End Sub
Function ColLetter(ColNumber As Long) As String
' from a comment on dailydoseofexcel.com
ColLetter = Application.Substitute _
(Cells(1, ColNumber).Address(False, False), "1", "")
End Function