VBA Code - Name Tables using a Cell's value

[Spaztic]

I have a tricky one. I have code that creates tables automatically by looking for the words "Check Item" in column B and creating a table from 'Check Item' until the row before it hits a blank. (In the image attached, it created a table for (B3:D6) and (B8:D12). There could be A LOT of tables created. Currently, the tables are named "Check1, Check2, Check3, ..." as you can see in my code.

What I'm wanting to do is automatically (using VBA code) name each of the tables with the cell value above 'Check Item' (e.g. Basement, Exterior). I guess these values would be 1 above and 1 to the left (in column A).

Not sure if it can be done or not. Would greatly appreciate any help you can give me!

Sub CreateTable()
Dim lr As Long, i As Integer
Dim cll As Range, rng As Range

With ActiveSheet
lr = .Cells(Rows.Count, 1).End(xlUp).Row
Set rng = .Range("B1:B" & lr)
i = 0
For Each cll In rng
If cll.Value = "Check Item" Then 'find header row
i = i + 1 'count table
.ListObjects.Add(xlSrcRange, .Range(cll, cll.End(xlDown).Offset(, 2)), , xlYes).Name = "Check" & i 'create table
.ListObjects("Check" & i).TableStyle = "" 'Use blank format for table
.ListObjects("Check" & i).ShowAutoFilterDropDown = False 'Remove dropdown arrows for each column in table
End If
Next cll
End With
End Sub

 

[NoSparks]

Shouldn't you be establishing the last row from column B rather than A ?

Try this

Sub CreateTables()
    Dim lr As Long, i As Integer
    Dim cll As Range, rng As Range

With ActiveSheet
    lr = .Cells(Rows.Count, "B").End(xlUp).Row  '<-- changed to column B
    Set rng = .Range("B1:B" & lr)
    
    For Each cll In rng
        If cll.Value = "Check Item" Then 'find header row
            i = i + 1
            .ListObjects.Add(xlSrcRange, .Range(cll, cll.End(xlDown).Offset(, 2)), , xlYes).Name = cll.Offset(-1, -1).Value
            .ListObjects(i).TableStyle = ""            'Use blank format for table
            .ListObjects(i).DataBodyRange.AutoFilter   'Remove dropdown arrows for each column in table
        End If
    Next cll
End With
End Sub