macro to create named ranges based on a header row.

hello, I need a macro that can set up some named ranges using the text in the header row and the sheet name. The header row will always be in row one, but the number of columns will be dynamic. The amount of rows in the range will need to be dynamic also. To clarify, every used cell stating in row 2 in a column will be the named range with the sheetname+text in row one of the column the actual name.

Thanks!
Clayton

Hello Clayton,

This will create named ranges based on the column headers and rows used in each column. It can be run later if there are any changes to ranges and the named ranges will be updated.

'Written: October 14, 2009
'Author:  Leith Ross
'Summary: Creates Named Ranges based on the Sheet name and the column headers in row 1.

Sub MakeNamedRanges()

  Dim C As Long
  Dim Header As String
  Dim LastCol As Long
  Dim RefStr As String
  Dim Rng As Range
  Dim RngEnd As Range
  Dim Wks As Worksheet
  
    Set Wks = ActiveSheet
    
      LastCol = Wks.Cells(1, Columns.Count).End(xlToLeft).Column
        For C = 1 To LastCol
          Set Rng = Cells(2, C)
          Set RngEnd = Wks.Cells(Rows.Count, C).End(xlUp)
          Set Rng = IIf(RngEnd.Row < Rng.Row, Rng, Wks.Range(Rng, RngEnd))
            RefStr = "'" & Wks.Name & "'!" & Rng.Address
            Header = Wks.Name & "_" & Replace(Wks.Cells(1, C), " ", "_")
            On Error Resume Next
              Wks.Parent.Names(Header).Delete
              Err.Clear
            On Error GoTo 0
            Wks.Parent.Names.Add Header, RefStr
        Next C
        
End Sub

Hello Clayton,

Problem was that a named range has to start with either a letter or underscore character. So, I switched the order around. The Header appears first then then worksheet name. I used periods instead of underscores to replace the spaces in the worksheet name. The header and worksheet are separated by an underscore. The change has been made to the attached workbook.

'Written: October 14, 2009
'Author:  Leith Ross
'Summary: Creates Named Ranges based on the Sheet name and the column headers in row 1.

Sub MakeNamedRanges()

  Dim C As Long
  Dim Header As String
  Dim LastCol As Long
  Dim RefStr As String
  Dim Rng As Range
  Dim RngEnd As Range
  Dim Wks As Worksheet
  
    Set Wks = ActiveSheet
    
      LastCol = Wks.Cells(1, Columns.Count).End(xlToLeft).Column
        For C = 1 To LastCol
          Set Rng = Cells(2, C)
          Set RngEnd = Wks.Cells(Rows.Count, C).End(xlUp)
          Set Rng = IIf(RngEnd.Row < Rng.Row, Rng, Wks.Range(Rng, RngEnd))
            RefStr = "'" & Wks.Name & "'!" & Rng.Address
            Header = Replace(Wks.Cells(1, C), " ", "_") & "_" & Replace(Wks.Name, " ", ".")
            On Error Resume Next
              Wks.Parent.Names(Header).Delete
              Err.Clear
            On Error GoTo 0
            Wks.Parent.Names.Add Header, RefStr
        Next C
        
End Sub