Excel Named Range Create By Column Header Name

Hello All,
I need a vba to do this. Not sure how to do it. I have a range “myRange”

As I go through each cell in myName, I keep creating name range for cells underneath the cel

For example: if cel = c1, then create a named range "c1" from D4 to D5
For example: if cel = c2, then create a named range "c2" from E4 to E5

For each cel in MyName
??
Next cel

Thank you
modelNamedRangeDone---Copy24.xlsm
RayneAsked:
Who is Participating?
 
nutschCommented:
It's not possible cause the name would conflict with cell addresses. C_1 would work, but not C1.

Here is the version with C_1

Sub asdfsa()
Dim cel As Range

For Each cel In Range("MyName")
    ActiveWorkbook.Names.Add "C_" & cel.Column - Range("MyName").Column + 1, cel.Offset(1).Resize(2)
Next cel

End Sub

Open in new window


Thomas
0
 
nutschCommented:
You shouldn't name a range C1 or C2, it will be confusing with the cell addresses.

Thomas
0
 
nutschCommented:
But you could use this with a different range name

Sub asdfsa()
Dim cel As Range

For Each cel In Range("MyName")
    ActiveWorkbook.Names.Add "Range_" & cel.Address(False, False), cel.Offset(1).Resize(2)
Next cel

End Sub

Open in new window

0
Cloud Class® Course: SQL Server Core 2016

This course will introduce you to SQL Server Core 2016, as well as teach you about SSMS, data tools, installation, server configuration, using Management Studio, and writing and executing queries.

 
zorvek (Kevin Jones)ConsultantCommented:
This routine will name each column based on the header.

Public Sub AddTableNames( _
        ByVal oTable As Range, _
        Optional ByVal lHeaderRows As Long = 1, _
        Optional ByVal sNamePrefix As String _
    )

' Add names for each of the data columns in the table. The column is named
' using all header rows. If a header row cell in the same column is part of a
' merged range then the merged range value is used.
'
' Syntax
'
' AddTableNames(oTable, [lHeaderRows], [sNamePrefix])
'
' oTable - The range containing the table headers and data.
'
' lHeaderRows - The number of header rows. The names used are derived from the
'   headers. Optional. If omitted then 1 as assumed.
'
' sNamePrefix - The prefix to use in front of each name. Optional. If omitted
'   no prefix ia assumed.

    Dim lRow As Long
    Dim lColumn As Long
    Dim oColumnRange As Range
    Dim sRangeName As String
   
    Set oColumnRange = oTable.Columns(1).Resize(oTable.Rows.Count - lHeaderRows).Offset(lHeaderRows)
    For lColumn = 1 To oTable.Columns.Count
        sRangeName = vbNullString
        For lRow = 1 To lHeaderRows
            sRangeName = sRangeName & oTable(lRow, lColumn).MergeArea(1, 1)
        Next lRow
        sRangeName = GetCleanDefinedName(sNamePrefix & sRangeName)
        AddName sRangeName, oColumnRange.Offset(0, lColumn - 1)
    Next lColumn

End Sub

Kevin
0
 
zorvek (Kevin Jones)ConsultantCommented:
It needs these support routuines.

Public Function AddName( _
        ByVal sName As String, _
        ByVal oRange As Range, _
        Optional ByVal bPrependTabName As Boolean = False _
    ) As Boolean

' Add the sName to the workbook in which the oRange is contained. Return True if
' successful, False otherwise.
'
' Syntax
'
' AddName(sName, oRange, [bPrependTabName])
'
' sName - The name to give the name.
'
' oRange - The range to which the name refers.
'
' bPrependTabName - Pass True to prefix the tab name to the name, False to use
'   the name as-is. Optional. If omitted then False is assumed.

    Dim sWorksheetName As String
    Dim sReference As String
   
    ' Ensure the name is a valid defined name and VB variable name
    sName = GetCleanVBName(GetCleanDefinedName(sName))
   
    ' Remove the sheet name from the front of the name if present (it is added later)
    If UCase(Left(sName, Len(sWorksheetName) + 1)) = UCase(sWorksheetName) & "_" Then
        sName = Mid(sName, Len(sWorksheetName) + 1)
    End If
   
    ' Do not add new name if empty
    If Len(sName) = 0 Then Exit Function
   
    ' Add the name to workbook
    sReference = "='" & oRange.Worksheet.name & "'!" & oRange.Address(ReferenceStyle:=xlR1C1)
    If bPrependTabName Then
        oRange.Worksheet.Parent.Names.Add name:=sWorksheetName & "_" & sName, RefersToR1C1:=sReference
    Else
        oRange.Worksheet.Names.Add sName, RefersToR1C1:=sReference
    End If
   
    AddName = True

End Function

Public Function GetCleanDefinedName( _
        ByVal sProposedName As String, _
        Optional ByVal sReplacementChar As String _
    ) As String

' Return a valid translation of the proposed defined name. A defined name can
' contain only characters, numbers, and underscores. It cannot be a cell
' reference (e.g., A1 or R1C1). It cannot start with a number. And it can not
' be any of the following values:
'
'   Print_Titles
'   Print_Area
'   Database
'   Criteria
'   Data_Form
'   Extract
'   Consolidate_Area
'   Sheet_Title
'   Recorder
'   _FilterDatabase
'   Auto_Open
'   Auto_Close
'   Auto_Activate
'   Auto_Deactivate
'
' Syntax
'
' GetCleanDefinedName(sProposedName, [sReplacementChar])
'
' sProposedName - The proposed defined name to be cleaned.
'
' sReplacementChar - Any single valid character that is used to replace invalid
'   characters. Runs of the replacement character are converted to a single
'   character. Optional. If omitted then a null string is used.

    Dim lPreviousLength As Long
    Dim oRange As Range
    Dim lIndex As Long
   
    ' Translate invalid characters to alternate text
    sProposedName = Replace(sProposedName, "%", "Pct")
   
    ' Translate illegal values
    Select Case sProposedName
        Case "Print_Titles": sProposedName = "PrintTitles"
        Case "Print_Area": sProposedName = "PrintArea"
        Case "Database": sProposedName = "DatabaseRange"
        Case "Criteria": sProposedName = "CriteriaRange"
        Case "Data_Form": sProposedName = "DataForm"
        Case "Extract": sProposedName = "ExtractRange"
        Case "Consolidate_Area": sProposedName = "ConsolidateArea"
        Case "Sheet_Title": sProposedName = "SheetTitle"
        Case "Recorder": sProposedName = "RecorderRange"
        Case "_FilterDatabase": sProposedName = "FilterDatabase"
        Case "Auto_Open": sProposedName = "AutoOpen"
        Case "Auto_Close": sProposedName = "AutoClose"
        Case "Auto_Activate": sProposedName = "AutoActivate"
        Case "Auto_Deactivate": sProposedName = "AutoDeactivate"
    End Select
   
    ' Check if name is a valid oRange reference
    On Error Resume Next
    Set oRange = ActiveSheet.Range(sProposedName)
    On Error GoTo 0
    If Not oRange Is Nothing Then
        sProposedName = sProposedName & mcRangeObjectName
    End If
   
    ' Remove remaining illegal characters
    For lIndex = 1 To Len(sProposedName)
        If Not Mid(sProposedName, lIndex, 1) Like "[A-Za-z0-9_]" Then
            If Len(sReplacementChar) = 0 Then
                Mid(sProposedName, lIndex, 1) = Space(1)
            Else
                Mid(sProposedName, lIndex, 1) = sReplacementChar
            End If
        End If
    Next lIndex
    If Len(sReplacementChar) = 0 Then
        sProposedName = Replace(sProposedName, Space(1), vbNullString)
    Else
        Do
            lPreviousLength = Len(sProposedName)
            sProposedName = Replace(sProposedName, sReplacementChar & sReplacementChar, sReplacementChar)
        Loop Until Len(sProposedName) = lPreviousLength
    End If
   
    ' Prepend an underscore if name starts with a number
    If Left(sProposedName, 1) Like "[0-9]" Then sProposedName = "_" & sProposedName
   
    GetCleanDefinedName = sProposedName

End Function

Kevin
0
 
RayneAuthor Commented:
Hello Thomas,

I checked your code: if renames them as Range_something. Is It possible to use c1,c2,c3,c4 instead like the header row cel values as the named range

Kevin –
For your code: I had issues trying it out. Can you give an example like how you would call it like..
Call  AddTableNames (?,?,?)
0
 
zorvek (Kevin Jones)ConsultantCommented:
AddTableNames Sheet1.[D3:E5]

The parameter is the table range including the header row. The other two parameters are optional.

Kevin
0
 
RayneAuthor Commented:
Perfect Thomas :)

Great work, yes, in actuality, there would longer string names, so it would work in that case

Thank you all for your help.
0
 
NorieVBA ExpertCommented:
Isn't there built-in functionality for this?
Range("MyName").CreateNames Top:=True, Left:=False, Bottom:=False, Right:=False

Open in new window

Or have I missed something in the question?
0
 
RayneAuthor Commented:
I am not sure how to get that working
0
 
NorieVBA ExpertCommented:
All you would do is run that line of code.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.