CODEWITHSUNDEEP
vbaexcel
Ben Simmons
Ben Simmons

Reputation: 329

Looping through different size tables Excel VBA

Previous question was answered providing me the foundation of this Loop.

VBA Excel - Loop through worksheet creating tables

However, I ran into an issue where I may have a table header with no data in the line right under it. In this case I simply want to make a table with just the header.

I have tried this code-simply assigning the row below rngStart as oneDown. And then creating an if/then to check if len(oneDown) is > 0.

`Dim ws As Worksheet
Set ws = ActiveSheet

With ws

'find last row of data in column A
Dim lRow As Long
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
Dim rngStart As Range
Set rngStart = .Range("A3")

'set counter variable for naming tables
Dim i As Long
i = i + 1
Dim oneDown As Long
Set oneDown =rngStart.Offset(1)

Do

if Len(oneDown) > 0 Then
    'create table range
    Set rngTable = .Range(rngStart.End(xlToRight),rngStart.End(xlDown))
    'create table
    .ListObjects.Add(xlSrcRange, rngTable.Resize(rngTable.Rows.Count, rngStart.End(xlToRight).Column), , xlYes).Name = "Table" & i
    'set style
    .ListObjects("Table" & i).TableStyle = "TableStyleLight9"
    'find next table range start
    Set rngStart = rngTable.End(xlDown).Offset(2)
 Else
'create table range
    Set rngTable = .Range(rngStart.End(xlToRight))
    'create table
    .ListObjects.Add(xlSrcRange, rngTable.Resize(rngTable.Rows.Count, rngStart.End(xlToRight).Column), , xlYes).Name = "Table" & i
    .ListObjects("Table" & i).TableStyle = "TableStyleLight9"
    Set rngStart = rngTable.End(xlDown).Offset(2)

End If
    i = i + 1

Loop Until rngStart.Row > lRow

End With`

I'm getting the same results with my data as if I didn't have the if/then in place.

Upvotes: 0

Views: 696

Answers (1)

Jonathan
Jonathan

Reputation: 663

I had to change part of your code but this worked with I test it so give it a try:

  Dim ws As Worksheet
    Set ws = ActiveSheet

    With ws

    'find last row of data in column A
    Dim lRow As Long
    lRow = .Range("A" & .Rows.Count).End(xlUp).Row
    Dim rngStart As Range
    Set rngStart = .Range("A3")

    'set counter variable for naming tables
    Dim i As Long
    i = i + 1

    Do

Dim oneDown As String
 oneDown = rngStart.Offset(1)

'Proceed to next cell if rngstart is empty
If rngStart.Value = "" Then
   Set rngStart = rngStart.Offset(1)
ElseIf Len(oneDown) > 0 Then
    'create table range
    Set rngtable = .Range(rngStart.End(xlToRight), rngStart.End(xlDown))
    'create table
    .ListObjects.Add(xlSrcRange, rngtable.Resize(rngtable.Rows.Count, rngStart.End(xlToRight).Column), , xlYes).Name = "Table" & i
    'set style
    .ListObjects("Table" & i).TableStyle = "TableStyleLight9"
    'find next table range start
    Set rngStart = rngtable.End(xlDown).Offset(1)
     i = i + 1
 Else
'create table range
    Set rngtable = .Range(rngStart.End(xlToRight), rngStart)
    'create table
    .ListObjects.Add(xlSrcRange, rngtable.Resize(rngtable.Rows.Count, rngStart.End(xlToRight).Column), , xlYes).Name = "Table" & i
    .ListObjects("Table" & i).TableStyle = "TableStyleLight9"
    Set rngStart = rngtable.End(xlDown).Offset(1)
     i = i + 1
End If


    Loop Until rngStart.Row > lRow

    End With

Upvotes: 1

Related Questions