Add dynamic ranges names to any worksheet

May 11, 2009JP6 CommentsRate This ArticlenewLinks 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.

Sub AddDynamicNames()
' 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.

About JP
I'm just an average guy who writes VBA code for a living. This is my personal blog. Excel and Outlook are my thing, with a sprinkle of Access and Word here and there. Follow this space if you want to learn more about VBA. Keep Reading »

↑ Scroll to top
Previous Post:

Next Post:

6 Response(s) to Add dynamic ranges names to any worksheet ↓

  1. Chuck says:

    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

  2. Tim Buckingham says:

    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.

    Sub AddDynamicRangeVertical()
        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
  3. JP says:

    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:

    ActiveWorkbook.Names.Add Name:=rngName, RefersTo:= _
        "=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.

  4. Vassilis Papadimitriou says:

    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

  5. Vassilis Papadimitriou says:

    I think that a correct syntax is:

    ActiveWorkbook.Names.Add Name:=wkshtName & "_" & rngName, RefersTo:= _
    "=OFFSET('" & ActiveWorkbook.ActiveSheet.Name & "'!" & rngAddr & ",1,0,COUNTA('" & ActiveWorkbook.ActiveSheet.Name & "'!$" & _
    columnLetter & ":$" & columnLetter & ")-1,1)"
  6. chrisham says:

    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

    Sub AddDynamicNames()
    ' 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

Speak Your Mind

Tell us what you're thinking...

Certain comments (including first-time comments) are subject to moderation and will not appear immediately. Please view the Comment Policy for more information. To post VBA code in your comment, use tags like this: [cc lang='vb']Code goes here[/cc].




Site last updated August 24, 2010 @ 5:56 pm