VBA to set cell contents as Named range name - vba

Question

I am trying to set the first 7 characters of the first cell in a range to be a named ranges name IF the cell begins with the word "kit".
Here is what I have so far:
Sub DefineRanges()
Dim rngStart As Range
Set rngStart = Range("A1")
Dim LastRow As Integer
Dim RangeName As String
For Each cell In Range("A2:A7")
If LCase(Left(cell.Value, 3)) = "kit" Then
RangeName = LCase(Left(cell.Value, 7))
ActiveWorkbook.Names.Add _
Name:=RangeName, _
RefersToLocal:=Range(rngStart.Address & ":C" & cell.Row - 1)
Set rngStart = Range("A" & cell.Row)
End If
LastRow = cell.Row
Next
RangeName = LCase(Left(cell.Value, 7))
ActiveWorkbook.Names.Add _
Name:=RangeName, _
RefersToLocal:=Range(rngStart.Address & ":C" & LastRow)
End Sub
Essentially I want it to look through my overall Range, find any cells that begin with the word "kit", create a named range that goes from that cell until the next cell that begins with "kit", and assign the first 7 characters of that cell to be the ranges name. So far I am able to get it to create the ranges, but I run into issues when I try to pass the contents of the cell into the range name. Any ideas?

Answer 1

This assumes that you data is similar to your last question.
It uses Match to find each "Kit..." saving a few iterations:
Sub DefineRanges()
Dim rngStart As Long
Dim RangeName As String
Dim col As Long
Dim PreFx As String
col = 1 'change to the column number you need
PreFx = "kat" 'change to the prefix you are looking for
With Worksheets("Sheet7") 'change to your sheet
On Error Resume Next
rngStart = Application.WorksheetFunction.Match(PreFx & "*", .Columns(col), 0)
On Error GoTo 0
If rngStart > 0 Then
Do
i = 0
On Error Resume Next
i = Application.WorksheetFunction.Match(PreFx & "*", .Range(.Cells(rngStart + 1, col), .Cells(.Rows.Count, col)), 0) + rngStart
On Error GoTo 0
If i > 0 Then
RangeName = LCase(Left(.Cells(rngStart, col).Value, 7))
ActiveWorkbook.names.Add name:=RangeName, RefersToLocal:=.Range(.Cells(rngStart, col), .Cells(i - 1, col + 2))
rngStart = i
Else 'no more "kit..." so find the last row with data and use that
i = Application.WorksheetFunction.Match("zzz", .Columns(col))
RangeName = LCase(Left(.Cells(rngStart, 1).Value, 7))
ActiveWorkbook.names.Add name:=RangeName, RefersToLocal:=.Range(.Cells(rngStart, col), .Cells(i - 1, col + 2))
End If
Loop While i < Application.WorksheetFunction.Match("zzz", .Columns(col))
End If
End With
End Sub