Add dynamic ranges names to any worksheet

6 Comments:

1. Chuck writes:
   May 11, 2009 at 12:12 pm

   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

   Reply
2. Tim Buckingham writes:
   May 11, 2009 at 7:19 pm

   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", , , , , , ,  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

   Reply
3. JP writes:
   May 14, 2009 at 9:40 pm

   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.

   Reply
4. Vassilis Papadimitriou writes:
   June 26, 2009 at 4:15 pm

   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

   Reply
5. Vassilis Papadimitriou writes:
   June 26, 2009 at 4:40 pm

   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)"

   Reply
6. chrisham writes:
   July 14, 2010 at 1:32 am

   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

   Reply

Add a Comment: Cancel reply