Excel VBA 'Format as Table' for all rows with data

Question

So I've create below macro with the record feature:

ActiveSheet.ListObjects.Add(xlSrcRange, Range("A1:L656"), , xlYes).Name = _
    "Table1"
Range("Table1[#All]").Select
ActiveSheet.ListObjects("Table1").TableStyle = "TableStyleLight15"
ActiveWindow.SmallScroll Down:=-21

The macro will 'Format as Table' the whole table, but instead of recording selecting all rows with data (like I did with shift + arrow keys) it recorded the absolute selection I needed it to select all from A1 to L(number of last occupied row) I had a solution to this but I lost it and haven't been able to find it again.

Thank you in advance!

A quick search will find the information you require... but to save you time here is a link: https://stackoverflow.com/questions/38882321/better-way-to-find-last-used-row — 5202456, Jul 01 '21 at 09:07

Алексей Р · Answer 1 · 2021-07-05T06:41:38.977

Try this code:

ActiveSheet.ListObjects.Add(xlSrcRange, _
            Range("A1").CurrentRegion, XlListObjectHasHeaders:=xlYes, _
            TableStyleName:="TableStyleLight15").Name = "Table1"

Before

After (if some columns have no headers, they will be created)

Side note: to prevent an error related to conflict of table names and/or ranges (you cannot create another table on the same sheet with the same name or range), you can use the IsOverlappedListObject function, which I wrote below with a usage example:

Function IsOverlappedListObject(rng As Range, TargetName As String, Optional Reason As String = "") As Boolean
    Dim x As ListObject
    On Error Resume Next
    Set x = rng.Parent.ListObjects(TargetName)
    If Err.Number = 0 Then
        IsOverlappedListObject = True
        Reason = "The ListObject named """ & TargetName & """ already exists on the worksheet """ & rng.Parent.Name & """"
    End If
    On Error GoTo out
    Reason = Reason & IIf(Reason = "", "", vbLf) & "The range " & rng.Address & " overlaps (at least) with the ListObject(""" & rng.ListObject.Name & """) on the " & rng.Parent.Name & " worksheet"
    IsOverlappedListObject = True
out:
End Function

' usage example
Sub MakeTable()
    Dim rng As Range, TargetName As String, Reason As String
    Set rng = Range("A1").CurrentRegion
    TargetName = "Table1"
    
    If IsOverlappedListObject(rng, TargetName, Reason) Then
        MsgBox "Can't make ListObject - the reason is " & vbLf & Reason, vbCritical
    Else
        ActiveSheet.ListObjects.Add(xlSrcRange, _
                    rng, XlListObjectHasHeaders:=xlYes, _
                    TableStyleName:="TableStyleLight15").Name = TargetName
    End If
End Sub

Are you able to tell me how to make columns 'have headers'? Your snippet works, but seemingly my rightmost two columns don't have headers and the snippet doesn't format them. — Lawrence, Jul 05 '21 at 04:57
If I understand the question correctly, you can control the table header definition by calling the [ListObjects.Add](https://learn.microsoft.com/en-us/office/vba/api/excel.listobjects.add) method with the value of the argument `XlistObjectHasHeaders`, which can take values from `XlYesNoGuess enumeration`. This example uses the named argument `XlListObjectHasHeaders:=xlYes`, which is the same as `xlYes`, coming as the fourth position argument in your code, and means that the first line in the selected range contains headers. If I misunderstood the question, please clarify — Алексей Р, Jul 05 '21 at 05:19

score 0 · Answer 2 · answered Jul 01 '21 at 10:17

Convert a Range to a Table

Option Explicit

Sub ConvertRangeToTable()
    
    ' Define constants.
    Const FirstRowAddress As String = "A1:L1"
    Const tblName As String = "Table1"
    Const tblStyleString As String = "TableStyleLight15"
     
    ' Attempt to create a reference to the worksheet.
    If ActiveSheet Is Nothing Then Exit Sub
    If ActiveSheet.Type <> xlWorksheet Then Exit Sub
    Dim ws As Worksheet: Set ws = ActiveSheet
    
    ' Attempt to create a reference to the range.
    Dim rg As Range
    With ws.Range(FirstRowAddress)
        Dim lCell As Range
        Set lCell = .Resize(.Worksheet.Rows.Count - .Row + 1) _
            .Find("*", , xlFormulas, , xlByRows, xlPrevious)
        If lCell Is Nothing Then Exit Sub
        Set rg = .Resize(lCell.Row - .Row + 1)
    End With
    
    ' Attempt to create a reference to the table.
    Dim tbl As ListObject
    On Error Resume Next
    Set tbl = ws.ListObjects(tblName)
    On Error GoTo 0
    
    ' If the table already exists, 'unlist' it.
    If Not tbl Is Nothing Then
        tbl.Unlist
    End If
    
    ' Convert the range to the table.
    Set tbl = ws.ListObjects.Add(xlSrcRange, rg, , xlYes)
    With tbl
        .Name = tblName
        .TableStyle = tblStyleString
    End With
    
    ' Clear the range below the table.
    With rg
        .Resize(.Worksheet.Rows.Count - .Row - .Rows.Count + 1) _
            .Offset(.Rows.Count).Clear
    End With

    ' Inform user of success.
    MsgBox "Created table '" & tblName & "' for the range '" _
        & rg.Address(0, 0) & "'.", vbInformation, "Convert Range to Table"

End Sub

Excel VBA 'Format as Table' for all rows with data

2 Answers2

Convert a Range to a Table