creating named ranges using a loop

[ajm]

i am trying to write a macro to loop through a column of data, creating a named range each time it encounters a certain string. so, it inititially finds the first instance of the string, then finds the next instance, offsets one row back and then names that as the first named range. how do i get it to actually loop through the column until the end of the data?

I can get the first range named but can't figure how to get a loop into my macro to repaeat the process.

Sub x()

    Dim rngTemp As Range
    Dim rngFind As Range
    Dim rngFirst As Range
    Dim rngLast As Range
    Dim nom As Range
    Dim strFirstAddress As String
    Dim lngRow As Long

    lngRow = Range("A" & Rows.Count).End(xlUp).Row + 1
    With Range("A:A")
        Set rngFind = .Find("VCH*", .Cells(lngRow, 1), LookIn:=xlValues, lookat:=xlPart)

        If Not rngFind Is Nothing Then
            strFirstAddress = rngFind.Address

            Set rngFirst = rngFind
            MsgBox rngFirst.Address '///$a$4
            
            'Set rngTemp = rngFirst
            'MsgBox rngFirst.Address '///$a$4
            
            Set rngFind = .FindNext(rngFind).Offset(-1)
            MsgBox rngFind.Address '///$a$8
i = 1
ActiveWorkbook.Names.Add Name:="rngname" & i, RefersToR1C1:= _
    ActiveSheet.Range(strFirstAddress & ":" & rngFind.Address)
   i = i + 1

 

[Norie]

You only seem to be looking for one value, or perhaps more accurately values beginning with VCH?

So is it only one named range where all the values have VCH at the start?

Or are you trying to create a named range every time you find a value starting VCH?



Or do yo

 

[Andrew Poulsom]

Is this what you want?

Sub xx()
    Dim i As Long
    Dim rngFind As Range
    Dim strFirstAddress As String
    i = 1
    With Range("A:A")
        Set rngFind = .Find("VCH*", .Cells(.Rows.Count, 1), LookIn:=xlValues, lookat:=xlPart)
        If Not rngFind Is Nothing Then
            strFirstAddress = rngFind.Address
            Do
                rngFind.Name = "rngname" & i
                i = i + 1
                Set rngFind = .FindNext(rngFind)
            Loop While Not rngFind Is Nothing And rngFind.Address <> strFirstAddress
        End If
    End With
End Sub