Creating named range based on value in column

问题

I want to create a named range based on the value of in column B.

For example (1, 21, great) (5, 21, sew) (6, 21, test) (7, 22, hi) (1, 21, random)

I want to create named range with name: UNIT21, and from the data above the refersto should be A2:C4 and A6:C6. And another named range= UNIT22 for data with 22 in its column B.

Problem now is, 1. I don't know how to select the whole row from A:C for respective row. And, 2. how to add new data to existing named range instead of replacing the existing value like what my code is doing right now.

A beginner in Excel VBA and programming. Thanks!

cross-posted

Sub naming()
Dim row_index As Long
Dim lastrow As Long: lastrow = 5

Dim NamedRange As Range
Dim celltomap As Range

Dim Rng As Range

For row_index = 1 To lastrow


    RangeName = Sheet3.Range("A2:C6").Cells(row_index, 2).Value
    Set celltomap = Sheet3.Range("A2:C6").Cells(row_index, 3)

    Sheet3.Names.Add Name:="UNIT" & RangeName, RefersTo:=celltomap

    MsgBox ("UNIT" & RangeName)

    Next row_index


End Sub

回答1:

Run the below code, it will create the range names.

The value of the named ranges will be {...} if the list is unsorted before you run the code.

Sub NameRanges()

    Dim cUnique As Collection
    Dim Rng As Range
    Dim Cell As Range
    Dim sh As Worksheet
    Dim vNum As Variant
    Dim FrstRng As Range
    Dim UnionRng As Range
    Dim c As Range

    Set sh = ThisWorkbook.Sheets("Sheet1")
    With sh
        Set Rng = .Range("B2:B" & .Cells(.Rows.Count, "B").End(xlUp).Row)
        Set cUnique = New Collection

        On Error Resume Next
        For Each Cell In Rng.Cells
            cUnique.Add Cell.Value, CStr(Cell.Value)
        Next Cell
        On Error GoTo 0

        For Each vNum In cUnique
            For Each c In Rng.Cells
                If c = vNum Then
                    If Not UnionRng Is Nothing Then
                        Set UnionRng = Union(UnionRng, c.Offset(, 1))   'adds to the range
                    Else
                        Set UnionRng = c.Offset(, 1)
                    End If
                End If
            Next c

            UnionRng.Name = "Unit" & vNum
            Set UnionRng = Nothing
        Next vNum
    End With

End Sub

There may be a time you want to delete the range names and start over.

Sub delete_RngNames()
    Dim rn As Name
    For Each rn In ActiveWorkbook.Names
        rn.Delete
    Next rn
End Sub

You did not indicate an ActiveX combobox on the worksheet or a UserForm.

This should work for both, just the buttonNames might be different.

Private Sub CommandButton1_Click()
    Dim s As String, rng As Range, c As Range

    s = "Unit" & Me.TextBox1

    Me.ComboBox1.Clear

    For Each c In Range(s).Cells
        Me.ComboBox1.AddItem c
    Next c

End Sub

This code assumes you have entered something in a textbox. Combining "Unit" & the textbox will indicate what range to populate the combobox

回答2:

this should do:

Option Explicit

Sub naming()
    Dim row_index As Long
    Dim lastrow As Long: lastrow = 5

    Dim celltomap As Range
    Dim RangeName As String
    Dim nm As Name

    For row_index = 1 To lastrow
        RangeName = Foglio1.Range("A2:C6").Cells(row_index, 2).Value
        Set celltomap = Foglio1.Range("A2:C6").Cells(row_index, 3)

        On Error Resume Next
        Set nm = Foglio1.Names("UNIT" & RangeName)
        On Error GoTo 0

        If nm Is Nothing Then ' first time you hit "UNIT" & RangeName -> set a new name
            Foglio1.Names.Add Name:="UNIT" & RangeName, RefersTo:=celltomap
        Else ' name already there -> update its 'RefersTo' property
            nm.RefersTo = Union(nm.RefersToRange, celltomap)
        End If
        Set nm = Nothing ' initialize 'nm' for subsequent 'If nm Is Nothing Then' check
    Next
End Sub

As you see I stuck to your original celltomap setting pattern, i.e.: only column "C" cells, but you can easily twink the code and expand to more columns

来源：https://stackoverflow.com/questions/59006163/creating-named-range-based-on-value-in-column