Excel VBA macro for dynamic named range

Question

I am looking for a simple macro for creating a dynamic named range for a table with this design:

       A      B
4    Title1 Title2
5    val_1  val_a
6    val_2  val_b
7    val_3  val_3

The requirements are:

The names of the dynamic named ranges should be equal to the headers (in this case, "Title1", "Title2").
One should be able to specify on which row the header lies (e.g. row 4).

(I have found two such macros (1, 2), but they all have bugs on the second requirement.)

you can still use vba to create the table if that's acceptable? — JosieP
a Table effectively is a dynamic named range: office.microsoft.com/en-gb/excel-help/… — JosieP
JosieP: create table > right click on row number next to table > option insert blocked — karamell

JosieP JosieP · Accepted Answer · 2013-07-08T10:58:56

here's a hacked version of Roger Govier's code

Sub CreateNames()
   Dim wb                     As Workbook
   Dim ws                     As Worksheet
   Dim rStartCell             As Range
   Dim rData                  As Range
   Dim rCol                   As Range
   Dim LastCol                As Long
   Dim lCol                   As Long
   Dim sSheet                 As String
   Dim Rowno                  As Long

   ' get table location
   On Error Resume Next
   Set rStartCell = Application.InputBox(prompt:="Select top left cell of table", Title:="Select first cell", Default:=ActiveCell, Type:=8)
   On Error GoTo err_handle
   If rStartCell Is Nothing Then Exit Sub

   Set ws = rStartCell.Worksheet
   Set wb = ws.Parent
   sSheet = "'" & ws.Name & "'"
   With rStartCell
      Rowno = .Row
      Set rData = .CurrentRegion
   End With

   ' get column count
   With rData
      LastCol = .Column + .Columns.Count - 1
   End With
   ' reset data range
   Set rData = ws.Range(rStartCell, ws.Cells(Rowno, LastCol))

   For Each rCol In rData.Columns

      lCol = rCol.Column
      wb.Names.Add Name:=Replace(rCol.Cells(1).Value, " ", "_"), _
                   RefersToR1C1:="=" & sSheet & "!" & rCol.Cells(1).Address(ReferenceStyle:=xlR1C1) & ":INDEX(C" & lCol & ",LOOKUP(2,1/(C" & lCol & "<>""""),ROW(C" & lCol & ")))"

   Next rCol

   MsgBox "All dynamic Named ranges have been created"
   Exit Sub

err_handle:

   MsgBox "Error " & Err.Number & " (" & Err.Description & _
          ") in procedure CreateNames"

End Sub

Excel VBA macro for dynamic named range

1 Answers