Tables

t

Add aTable

Application.CutCopyMode = False
wsReport.ListObjects.Add(xlSrcRange, Range("$A$6:$I$7"), , xlYes).Name = "FtrTable"
wsReport.ListObjects("FtrTable").TableStyle = "TableStyleMedium10" '"TableStyleMedium17" '"TableStyleLight10"
wsReport.Range("$A$6:$I$7").VerticalAlignment = xlTop

Add a Column to a Table

Dim ws As Worksheet
Set ws = ActiveSheet
Dim tbl As ListObject
Set tbl = ws.ListObjects("Sales_Table")
'add a new column as the 5th column in the table
tbl.ListColumns.Add(5).Name = "TAX"
'add a new column at the end of the table
tbl.ListColumns.Add.Name = "STATUS"

Add a Row to a Table

Dim ws As Worksheet
Set ws = ActiveSheet
Dim tbl As ListObject
Set tbl = ws.ListObjects("Sales_Table")
‘add a row at the end of the table
tbl.ListRows.Add
‘add a row as the fifth row of the table (counts the headers as a row)
tbl.ListRows.Add 5

Delete Row or Column

Dim ws As Worksheet
Set ws = ActiveSheet
Dim tbl As ListObject
Set tbl = ws.ListObjects("Sales_Table")
tbl.ListColumns(2).Delete
tbl.ListRows(2).Delete

Add Row and Enter Data

Dim ws As Worksheet
Set ws = ActiveSheet
Dim tbl As ListObject
Set tbl = ws.ListObjects("Sales_Table")
Dim newrow As ListRow
Set newrow = tbl.ListRows.Add
With newrow
    .Range(1) = 83473
    .Range(2) = "HJU -64448"
    .Range(3) = 5
End With

Add/Overwrite Data in a Specific Record

Dim ws AsWorksheet
Set ws =ActiveSheet
Dim tbl AsListObject
Set tbl =ws.ListObjects("Sales_Table")
Withtbl.ListRows(3)
   .Range(3)= 8
   .Range(6)= "CASH"
End With

Check if activecell is in table

If Intersect(ActiveCell, ActiveSheet.ListObjects("Table1").DataBodyRange) Is Nothing Then
  MsgBox "activecell not in Table1"
Else
  MsgBox "activecell in Table1"
End If...

Sort a table

Sort on values

Dim ws As Worksheet
Set ws = ActiveSheet
Dim tbl As ListObject
Set tbl = ws.ListObjects("Sales_Table")
Dim sortcolumn As Range
Set sortcolumn = Range("Sales_Table[TRANS_VALUE]")
With tbl.Sort
   .SortFields.Clear
   .SortFields.Add Key:=sortcolumn, SortOn:=xlSortOnValues, Order:=xlDescending
   .Header = xlYes
   .Apply
End With

Sort on colors
To sort by cell colour, specify this in the SortOn parameter of the Add method. You then have to specify the colour to sort by using the SortOnValue property of the SortField object (see below).

Dim ws As Worksheet
Set ws = ActiveSheet
Dim tbl As ListObject
Set tbl = ws.ListObjects("Sales_Table")
Dim sortcolumn As Range
Set sortcolumn = Range("Sales_Table[TRANS_VALUE]")
With tbl.Sort
  .SortFields.Clear
  .SortFields.Add(Key:=sortcolumn, Order:=xlAscending, SortOn:=xlSortOnCellColor).SortOnValue.Color =RGB(255, 255, 0)
  .Header = xlYes
  .Apply
End With

Select (parts of) a table

With these codes you can select different parts of a table.
Entire Table: ActiveSheet.ListObjects("Table1").Range.Select

Table Header Row: ActiveSheet.ListObjects("Table1").HeaderRowRange.Select

Table Data: ActiveSheet.ListObjects("Table1").DataBodyRange.Select

Third Column: ActiveSheet.ListObjects("Table1").ListColumns(3).Range.Select

Multiple Columns:
Dim ws As Worksheet Dim tbl As ListObject


Set ws = Sheets("Sheet1")

Set tbl = ws.ListObjects(1)

Range(tbl &"[[Column1]:[Column5]]".Select

Third Column (Data Only):
ActiveSheet.ListObjects("Table1").ListColumns(3).DataBodyRange.Select

Select Row 4 of Table Data:
ActiveSheet.ListObjects("Table1").ListRows(4).Range.Select

Select 3rd Heading:
ActiveSheet.ListObjects("Table1").HeaderRowRange(3).Select

Select Data point in Row 3, Column 2:
ActiveSheet.ListObjects("Table1").DataBodyRange(3, 2).Select

Subtotals:
ActiveSheet.ListObjects("Table1").TotalsRowRange.Select

Disable autofill formula's in table

Application.AutoCorrect.AutoFillFormulasInLists = False

Enable/Disable autoextend table

For all tables:

Sub EnableTableAutoExpansion()
  Dim ws As Worksheet

For Each ws In ThisWorkbook.Worksheets
ws.ListObjects.AutoExpand = True
Next ws
End Sub

For a specific table:

Sub EnableSpecificTableAutoExpansion(tableName As String)
Dim ws As Worksheet

For Each ws In ThisWorkbook.Worksheets
Dim tbl As ListObject
Set tbl = ws.ListObjects(tableName)
If Not tbl Is Nothing Then
tbl.AutoExpand = True
End If
Next ws
End Sub

Call with:

EnableSpecificTableAutoExpansion "Tab1"

Get column number from table header

[MyTable].Cells(2, [MyTable[MyColumn]].Column)

Table to Array

Sub MultiColumnTable_To_Array()
Dim myTable As ListObject
Dim myArray As Variant
Dim x As Long
'Set path for Table variable
  Set myTable = ActiveSheet.ListObjects("Table1")
'Create Array List from Table
  myArray = myTable.DataBodyRange
'Loop through each item in Third Column of Table (displayed in Immediate Window [ctrl + g])
  For x = LBound(myArray) To UBound(myArray)
    Debug.Print myArray(x, 3)
  Next x
End Sub

t