We value your feedback.
Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!
Sub CreateNames() ' written by Roger Govier, Technology4U Dim wb As Workbook, WS As Worksheet Dim lrow As Long, lcol As Long, I As Long Dim myName As String, Start As String ' set the row number where headings are held as a constant ' change this to the row number required if not row 1 Const Rowno = 1 ' set the Offset as the number of rows below Rowno, where the ' data begins Const ROffset = 1 ' set the starting column for the data, in this case 1 ' change if the data does not start in column A Const Colno = 1 ' Set an Offset from the starting column, for the column number that ' will always have data entered, and will therefore be used in calculating lrow Const COffset = 0 ' in this case, the first column will always contain data. On Error GoTo CreateNames_Error Set wb = ActiveWorkbook Set WS = ActiveSheet ' count the number of columns used in the row designated to ' have the header names lcol = Cells(Rowno, Columns.Count).End(xlToLeft).Column lrow = WS.Cells(Rows.Count, Colno).End(xlUp).Row Start = Cells(Rowno, Colno).Address wb.Names.Add Name:="lcol", RefersTo:="=COUNTA($" & Rowno & ":$" & Rowno & ")" wb.Names.Add Name:="lrow", RefersToR1C1:="=COUNTA(C" & Colno + COffset & ")" wb.Names.Add Name:="myData", RefersTo:= _ "=" & Start & ":INDEX($1:$1048576," & "lrow," & "Lcol)" For I = Colno To lcol ' if a column header contains spaces, replace the space with an underscore ' spaces are not allowed in range names. myName = Replace(Cells(Rowno, I).Value, " ", "_") If myName = "" Then ' if column header is blank, warn the user and stop the macro at that point ' names will only be created for those cells with text in them. MsgBox "Missing Name in column " & I & vbCrLf _ & "Please Enter a Name and run macro again" Exit Sub End If wb.Names.Add Name:=myName, RefersToR1C1:= _ "=R" & Rowno + ROffset & "C" & I & ":INDEX(C" & I & ",lrow)" nexti: Next I On Error GoTo 0 MsgBox "All dynamic Named ranges have been created" Exit Sub Exit Sub CreateNames_Error: MsgBox "Error " & Err.Number & " (" & Err.Description & _ ") in procedure CreateNames of Module Technology4U" End Sub