VBA code to create multiple tables

[Spaztic]

Hi, this may be extremely difficult but I thought I'd see if anyone can help me. I'm looking for a VBA code that automatically creates tables. Here is what I'm looking at:

Looking at the attached image,

1. it would look at Column A and find the first cell with text (A3 in this case)
2. it would then find the last row of text, in Column A, before the next blank (A6 in this case). Maybe it finds the blank in A7 and backs up to A6.
3. it would create a table for A3:D6 (with A3, B3, C3, D3 as the headers)
4. it would then find the next Column A cell that has text (A8 in this case). It probably needs to start at A7 to to find the next cell with text.

• And it would do the same as above for creating another table
• This would repeat until Column A doesn't contain any more text

Is this possible at all?

 

[eiloken]

try this, i saw that your table has "Color" in column A as first cell of table so i create code to find all cell in column A that has same value and find all non-blank cell after that and set it to table:

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("A1:A" & lr)
        i = 0
        For Each cll In rng
            If cll.Value = "Color" Then 'find header row
                i = i + 1 'count table
                .ListObjects.Add(xlSrcRange, .Range(cll, cll.End(xlDown).Offset(, 3)), , xlYes).Name = "Table" & i 'create table
            End If
        Next cll
    End With
End Sub

 

[Spaztic]

Thank you SO much! This worked!

 

[Spaztic]

One last thing, is there a way to edit the code to format the tables automatically to be 'Table Style' = none"?

 

[eiloken]

One last thing, is there a way to edit the code to format the tables automatically to be 'Table Style' = none"?

you can change code like this:

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("A1:A" & lr)
        i = 0
        For Each cll In rng
            If cll.Value = "Color" Then 'find header row
                i = i + 1 'count table
                .ListObjects.Add(xlSrcRange, .Range(cll, cll.End(xlDown).Offset(, 3)), , xlYes).Name = "Table" & i 'create table
                .ListObjects("Table" & i).TableStyle = "" 'Change table style to none
            End If
        Next cll
    End With
End Sub