Need help in creating a for loop to name each non empty cell in a range a unique name-CodePudding

I tried the code below, but unfortunately, it only names the last cell in the range as opposed to each cell in the range.

I am trying to run this loop so that starting from cell A1, any non empty cells are named "Guidance 1", "Guidance2", and so on and so forth.

Below is the code I have so far:

Sub GiveAllCellsNames()

    Dim wb As Workbook

    Set wb = ActiveWorkbook

    Dim R As Range

    Dim NameX As String

    Static I As Long

    I = I   1
 
    NameX = "Guidance" & I

    For Each R In Range("A1:A390").Cells

        If R.Value <> "" Then

            With R

                wb.Names.Add NameX, RefersTo:=R

            End With

        End If

    Next R

End Sub

I have tried this loop without using the "with statement" on the "R" range variable and still seem to get the same result. I have also tried to find articles relating to this **naming **topic in conjunction with loop guidance, but have only been able to find guidance available on naming entire ranges rather than looping through.

Any help would be appreciated.

Thank you in advance.

CodePudding user response：

A named range can be added using the Range object's name property.

Change

 wb.Names.Add NameX, RefersTo:=R

 R.Name = NameX

I need to be incremented and the name should be updated inside the loop.

Sub GiveAllCellsNames()

    Dim wb As Workbook

    Set wb = ActiveWorkbook

    Dim R As Range

    Dim NameX As String

    Static I As Long

    For Each R In Range("A1:A390").Cells

        If R.Value <> "" Then
        
            I = I   1
            NameX = "Guidance" & I
            
            With R

                wb.Names.Add NameX, RefersTo:=R

            End With

        End If

    Next R

End Sub

CodePudding user response：

Name Non-Blank Cells

Sub NameAllCells()

    Const BeginsWithString As String = "Guidance"

    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim ws As Worksheet: Set ws = wb.Worksheets("Sheet1")
    Dim rg As Range: Set rg = ws.Range("A1:A390")
    Dim Data() As Variant: Data = rg.Value
    
    DeleteNamesBeginsWith wb, BeginsWithString
    
    Dim r As Long
    Dim n As Long
    
    For r = 1 To UBound(Data, 1)
        If Len(CStr(Data(r, 1))) > 0 Then
            n = n   1
            wb.Names.Add BeginsWithString & n, rg.Cells(r)
        End If
    Next r

End Sub

Sub DeleteNamesBeginsWith( _
        ByVal wb As Workbook, _
        ByVal BeginsWithString As String)
    
    Dim nmLen As Long: nmLen = Len(BeginsWithString)
    
    Dim nm As Name
    
    For Each nm In wb.Names
        If InStr(1, nm.Name, BeginsWithString, vbTextCompare) = 1 Then nm.Delete
    Next nm
    
End Sub