How to apply Table Style to current selection-CodePudding

I got a doubt/problem with VBA while creating a macro. Basically I want to apply a Table "Style" to my current selection which is the following:

Range("A1:J1").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False

The macro I recorded then applies a Table with the following code:

 ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$J$319"), , xlYes).Name = _
    "Table4"
ActiveSheet.ListObjects("Table4").TableStyle = "TableStyleLight15"
With Selection
    .HorizontalAlignment = xlGeneral
    .VerticalAlignment = xlCenter
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
End With
With Selection
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
End With

Now what I am concerned about is in the really first line, the Range("$A$1:$J$319") which is clearly the interval I selected with the first three lines of code. Is there a way to make this range something like this?

ActiveSheet.ListObjects.Add(xlSrcRange, Range("Selection"), , xlYes).Name = _
    "Table4"

I want something like this because my interval could change in the future (by being 50 lines less or more) and I don't want the table to be applied to empty or more lines...

I hope I explained myself clearly! Thank you!

CodePudding user response：

Range.CurrentRegion can be used to reference all the connected cells (a.k.a. contiguous cells).

It would be best to set a reference to the ListObject because it has many built in properties that allow us to reference it's different parts.

Dim ListObject As ListObject
Set ListObject = ActiveSheet.ListObjects.Add(xlSrcRange, Range("A1").CurrentRegion, , xlYes)
With ListObject
    .Name = "Table4"
    .TableStyle = "TableStyleLight15"
End With

With ListObject.Range
    .HorizontalAlignment = xlGeneral
    .VerticalAlignment = xlCenter
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
End With

CodePudding user response：

I would use a function to add the listobject.

You pass the top left corner of your future table to the function - e.g. activesheet.range("A1").

The function then uses - as TinMan - explained CurrentRegion to add the listobject.

If you pass a name and or TableStyle to the function they will be applied. If TableName already exists - an counter will be added to the name.

If the Style doesn't exists the error will be ignored.

Public Function addListobject(rgTopLeftCorner As Range, _
    Optional TableName As String, Optional TableStyle As String) As ListObject
    
Dim ws As Worksheet
Set ws = rgTopLeftCorner.Parent

Dim lo As ListObject
Set lo = ws.ListObjects.Add(xlSrcRange, rgTopLeftCorner.CurrentRegion)

With lo
    
    If LenB(TableName) > 0 Then
        On Error Resume Next
        lo.Name = TableName
        If Err <> 0 Then
            'this will handle the case that supplied TableName is already in use
            Dim i As Long, TableNameNew As String
            Do
                Err.Clear
                i = i   1
                TableNameNew = TableName & "_" & i
                lo.Name = TableNameNew
            Loop Until Err = 0
        End If
        On Error GoTo 0
    End If
    

    If LenB(TableStyle) > 0 Then
        On Error Resume Next    'in case style does not exist
        lo.TableStyle = TableStyle
        On Error GoTo 0
    End If

End With

Set addListobject = lo
 
End Function

You can call this function like this:

Sub test()

Dim lo As ListObject
Set lo = addListobject(Selection, "test")
Debug.Print lo.Name

Set lo = addListobject(Selection.Offset(, 5), "test")
Debug.Print lo.Name 'will return test_1

Set lo = addListobject(Selection.Offset(, 10), "test")
Debug.Print lo.Name 'will return test_2

End Sub

I am pretty sure that you don't need the

With ListObject.Range
    .HorizontalAlignment = xlGeneral
    ...

part - esp. if you set the table style. This is presumably an artefact from macro recording ...