VBA create names for columns-CodePudding

So I have a worksheet called "gar_nv" containing in its first row some strings that I'd like to define as names for my columns. For instance, first cell of column A is "Number", I'd like to refer to the column A(starting from the second cell) as "Number" instead of column "A".

Sub NameCol()

Dim LastRow As Long
Dim x As Long, Rng As Range

With gar_nv
    For x = 1 To .UsedRange.Columns.Count
    
        LastRow = Cells(Cells.Rows.Count, x).End(xlUp).Row
        Set Rng = Cells(2, x).Resize(LastRow)
        .Names.Add Name:=Cells(1, x), RefersTo:=Rng
        Set Rng = Nothing
    Next

End With
End Sub

When I test my code like this, it throws a 91 error, what am I doing wrong?

Sub test()
With gar_nv

For Each Rng In .Range("Number")
    MsgBox (Rng.Value)
Next
End With
End Sub

CodePudding user response：

Create Names for Columns of Data

gar_nv is the code name of a worksheet in the workbook containing this code.

Option Explicit

Sub NameColumnsData()
    
    ' Delete all previous names in the worksheet.
    'DeleteAllWorksheetNames gar_nv
    
    Dim hrg As Range ' header range
    Dim drg As Range ' data range
    Dim cCount As Long ' number of columns
    
    With gar_nv.UsedRange
        Set hrg = .Rows(1)
        Set drg = .Resize(.Rows.Count - 1).Offset(1)
        cCount = .Columns.Count
    End With
    
    Dim crg As Range
    Dim c As Long
    Dim cTitle As String
    
    For c = 1 To cCount
        cTitle = hrg.Cells(c).Value
        Set crg = drg.Columns(c)
        gar_nv.Names.Add cTitle, crg
        ' Of course, you can lose the variables and just do:
        'gar_nv.Names.Add hrg.Cells(c).Value, drg.Columns(c)
    Next c
 
    MsgBox "Column data names created.", vbInformation
 
End Sub

Sub NameColumnsDataTEST()
    Dim cCell As Range
    With gar_nv
        For Each cCell In .Range("Number").Cells
            ' Caution! If there are many cells it may take 'forever'.
            'MsgBox cCell.Address(0, 0) & ": " & cCell.Value
            ' Rather print to the Immediate window (Ctrl G):
            Debug.Print cCell.Address(0, 0) & ": " & cCell.Value
        Next
    End With
End Sub

Sub DeleteAllWorksheetNames(ByVal ws As Worksheet)
    Dim nm As Name
    For Each nm In ws.Names
        Debug.Print nm.Name, nm.RefersTo, "Deleted!"
        nm.Delete
    Next nm
End Sub