Working with Tables in Excel (VBA)
Introduction
In Working with Tables in Excel I promised to add a page about working with those tables in VBA too. Well, here you go.
It's a ListObject!
On the VBA side there seems to be nothing new about Tables. They are addressed as ListObjects, a collection that was introduced with Excel 2003. But there are significant changes to this part of the object model and I am only going to touch on the basic parts here.
Creating a table
Converting a range to a table starts with the same code as in Excel 2003:
Sub CreateTable()
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$B$1:$D$16"),
, xlYes).Name = _
"Table1"
'No go in 2003
ActiveSheet.ListObjects("Table1").TableStyle =
"TableStyleLight2"
End Sub
But the new stuff is right there already: TableStyles. A collection of objects which are a member of the Workbook object. This gives rise to some oddities. You can change the formatting of a tableStyle, e.g. like this:
Sub ChangeTableStyles()
'No Go in Excel 2003
ActiveWorkbook.TableStyles(2).TableStyleElements(xlWholeTable) _
.Borders(xlEdgeBottom).LineStyle =
xlDash
End Sub
This changes the linestyle of the bottom of your table. But hold your horses! If you have any other workbook open, all tables with the same tablestyle appear in your changed style! But if you save your file, close Excel and open Excel again with the file, the changes are gone. This is because you've just changed a built-in tablestyle. If you ask me, I find it strange that the Workbook is a tablestyles' parent, whereas built-in table styles behave as if being bound to the Application object.
If you want full control over your table style, you'd better duplicate a built-in style and modify and apply that style to your table.
Listing the tables
Let's start with finding all tables on the active worksheet:
Sub FindAllTablesOnSheet()
Dim oSh As Worksheet
Dim oLo As ListObject
Set oSh = ActiveSheet
For Each oLo In oSh.ListObjects
Application.Goto oLo.Range
MsgBox "Table found: " & oLo.Name &
", " & oLo.Range.Address
Next
End Sub
This snippet of code works exactly the same in Excel 2003, so nothing new there (well, that is, in 2003 those tables ARE called Lists).
Selecting parts of tables
You might need to work with specific parts of a table. Here is a couple of examples on how to achieve that. The code comments show you where Excel 2003 differs from 2013, 2010 and 2007.
Sub SelectingPartOfTable()
Dim oSh As Worksheet
Set oSh = ActiveSheet
'1: with the listobject
With oSh.ListObjects("Table1")
MsgBox .Name
'Select entire table
.Range.Select
'Select just the data of the entire
table
.DataBodyRange.Select
'Select third column
.ListColumns(3).Range.Select
'Select only data of first column
'No go in 2003
.ListColumns(1).DataBodyRange.Select
'Select just row 4 (header row
doesn't count!)
.ListRows(4).Range.Select
End With
'No go in 2003
'2: with the range object
'select an entire column (data only)
oSh.Range("Table1[Column2]").Select
'select an entire column (data plus header)
oSh.Range("Table1[[#All],[Column1]]").Select
'select entire data section of table
oSh.Range("Table1").Select
'select entire table
oSh.Range("Table1[#All]").Select
'Select one row in table
oSh.Range("A5:F5").Select
End Sub
As you may have spotted, Excel 2013, 2010 and 2007 handle tables like they are range names. Well, that is exactly what is going on. After inserting a table, a range name is defined automatically. These range names are special though. Excel controls them entirely. You cannot delete them and they get renamed automatically when you change a table's name. Remove a table (convert back to range) and the defined name is removed as well.
Inserting rows and columns
Another part in which lists already had most of the functionality. Just a few new things have been added, like the "AlwaysInsert" argument to the ListRows.Add method:
Sub TableInsertingExamples()
'insert at specific position
Selection.ListObject.ListColumns.Add Position:=4
'insert right
Selection.ListObject.ListColumns.Add
'insert above
Selection.ListObject.ListRows.Add (11)
'NoGo in 2003
'insert below
Selection.ListObject.ListRows.Add AlwaysInsert:=True
End Sub
If you need to do something with a newly inserted row, you can set an object variable to the new row:
Dim oNewRow As ListRow
Set oNewRow =
Selection.ListObject.ListRows.Add(AlwaysInsert:=True)
If you then want to write something in the first cell of the new row you can use:
oNewRow.Range.Cells(1,1).Value="Value For New cell"
Adding a comment to a table
This is something Excel 2003 cannot do and is related to the fact that a table is a range name. Adding a comment to a table through the UI is a challenge, because you have to go to the Name Manager to do that. In VBA the syntax is:
Sub AddComment2Table()
Dim oSh As Worksheet
Set oSh = ActiveSheet
'NoGo in 2003
'add a comment to the table (shows as a comment to
'the rangename that a table is associated with automatically)
'Note that such a range name cannot be deleted!!
'The range name is removed as soon as the table is converted
to a range
oSh.ListObjects("Table1").Comment = "This is a table's
comment"
End Sub
Convert a table back to a normal range
That is simple and uses the identical syntax as 2003:
Sub RemoveTableStyle()
Dim oSh As Worksheet
Set oSh = ActiveSheet
'remove table or list style
oSh.ListObjects("Table1").Unlist
End Sub
Special stuff: Sorting and filtering
With Excel 2013, 2010 and 2007 we get a whole new set of filtering and sorting options. I'm only showing a tiny bit here, a Sort on cell color (orangish) and a filter on the font color. The code below doesn't work in Excel 2003. A List in 2003 only has the default sort and autofilter possibilities we have known since Excel 5 and which had hardly been expanded at all in the past 12 years or so.
Sub SortingAndFiltering()
'NoGo in 2003
With
ActiveWorkbook.Worksheets("Sheet1").ListObjects("Table1")
.Sort.SortFields.Clear
.Sort.SortFields.Add( _
Range("Table1[[#All],[Column2]]"), xlSortOnCellColor, xlAscending, , _
xlSortNormal).SortOnValue.Color = RGB(255, 235, 156)
With .Sort
.Header =
xlYes
.MatchCase =
False
.Orientation
= xlTopToBottom
.SortMethod =
xlPinYin
.Apply
End With
End With
'Only old autofilter stuff works in 2003
ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=2,
_
Criteria1:=RGB(156, 0, 6),
Operator:=xlFilterFontColor
End Sub
Accessing the formatting of a cell inside a table
You may wonder why this subject is there, why not simply ask for the cell.Interior.ThemeColor if you need the ThemeColor of a cell in a table? Well, because the cell formatting is completely prescribed by the settings of your table and the table style that has been selected. So in order to get at a formatting element of a cell in your table you need to:
- Find out where in your table the cell is located (on header row, on first column, in the bulk of the table
- Determine the table settings: does it have row striping turned on, does it have a specially formatted first column, ...
- Based on these pieces of information, one can extract the appropriate TableStyleElement from the table style and read its properties.
The function shown here returns the TableStyleElement belonging to a cell oCell inside a table object called oLo:
'-------------------------------------------------------------------------
' Procedure : GetStyleElementFromTableCell
' Company : JKP Application Development Services (c)
' Author : Jan Karel Pieterse
' Created : 2-6-2009
' Purpose : Function to return the proper style element from a cell inside a table
'-------------------------------------------------------------------------
Dim lRow As Long
Dim lCol As Long
'Determine on what row we are inside the table
lRow = oCell.Row - oLo.DataBodyRange.Cells(1, 1).Row
lCol = oCell.Column - oLo.DataBodyRange.Cells(1, 1).Column
With oLo
If lRow < 0 And .ShowHeaders Then
'on first row and has header
Set GetStyleElementFromTableCell = oLo.TableStyle.TableStyleElements(xlHeaderRow)
ElseIf .ShowTableStyleFirstColumn And lCol = 0 Then
'On first column and has first column style
Set GetStyleElementFromTableCell = oLo.TableStyle.TableStyleElements(xlFirstColumn)
ElseIf .ShowTableStyleLastColumn And lCol = oLo.Range.Columns.Count - 1 Then
'On last column and has last col style
Set GetStyleElementFromTableCell = oLo.TableStyle.TableStyleElements(xlLastColumn)
ElseIf lRow = .DataBodyRange.Rows.Count And .ShowTotals Then
'On last row and has total row
Set GetStyleElementFromTableCell = oLo.TableStyle.TableStyleElements(xlTotalRow)
Else
If .ShowTableStyleColumnStripes And Not .ShowTableStyleRowStripes Then
'in table, has column stripes
If lCol Mod 2 = 0 Then
Set GetStyleElementFromTableCell = oLo.TableStyle.TableStyleElements(xlColumnStripe1)
Else
Set GetStyleElementFromTableCell = oLo.TableStyle.TableStyleElements(xlWholeTable)
End If
ElseIf .ShowTableStyleRowStripes And Not .ShowTableStyleColumnStripes Then
'in table, has column stripes
If lRow Mod 2 = 0 Then
Set GetStyleElementFromTableCell = oLo.TableStyle.TableStyleElements(xlRowStripe1)
Else
Set GetStyleElementFromTableCell = oLo.TableStyle.TableStyleElements(xlWholeTable)
End If
ElseIf .ShowTableStyleColumnStripes And .ShowTableStyleRowStripes Then
If lRow Mod 2 = 0 And lCol Mod 2 = 0 Then
Set GetStyleElementFromTableCell = oLo.TableStyle.TableStyleElements(xlRowStripe1)
ElseIf lRow Mod 2 <> 0 And lCol Mod 2 = 0 Then
Set GetStyleElementFromTableCell = oLo.TableStyle.TableStyleElements(xlColumnStripe1)
ElseIf lRow Mod 2 = 0 And lCol Mod 2 <> 0 Then
Set GetStyleElementFromTableCell = oLo.TableStyle.TableStyleElements(xlRowStripe1)
Else
Set GetStyleElementFromTableCell = oLo.TableStyle.TableStyleElements(xlWholeTable)
End If
End If
End If
End With
End Function
You could use this function like this:
Dim oLo As ListObject
Dim oTSt As TableStyleElement
Set oLo = ActiveSheet.ListObjects(1)
Set oTSt = GetStyleElementFromTableCell(ActiveCell, oLo)
With ActiveCell.Offset(, 8)
.Interior.ThemeColor = oTSt.Interior.ThemeColor
.Interior.TintAndShade = oTSt.Interior.TintAndShade
End With
End Sub
Removing formating from an Excel Table
Suppose you have just converted a range to a table, but the range had some formatting set up such as background fills and borders. Tables allow you to format things like that automatically, but now your preexisting formatting messes up the table formatting. One way to overcome this is by changing the style of the cells (see this article) in the table back to the Normal style. This however removes your number formats too. The little macro below fixes that by first making a copy of the normal style, setting its Number checkbox to false and then applying the new style without number format to the table. Finally it applies the tablestyle and deletes the temporary style:
Dim oStNormalNoNum As Style
On Error Resume Next
Set oStNormalNoNum = ActiveWorkbook.Styles("NormalNoNum")
On Error GoTo 0
If oStNormalNoNum Is Nothing Then
ActiveWorkbook.Styles.Add "NormalNoNum"
Set oStNormalNoNum = ActiveWorkbook.Styles("NormalNoNum")
oStNormalNoNum.IncludeNumber = False
End If
With ActiveSheet.ListObjects(1)
.Range.Style = "NormalNoNum"
'Now apply tablestyle:
.TableStyle = "TableStyleLight1"
End With
ActiveWorkbook.Styles("NormalNoNum").Delete
End Sub
Note that the function shown above does not take into account that you can set the width of the stripes, both vertically and horizontally.
Wrap Up
Of course there is more to learn and know about tables and lists. A good way to come acquainted with the VBA behind them is by recording macro's while fooling around with them. Luckily Microsoft did include the table object if it comes to recording your actions, unlike the omission on the charting side...
Comments
Showing last 8 comments of 851 in total (Show All Comments):Comment by: João Figueiredo (29-5-2020 16:52:00) deeplink to this comment
Sorry, for my English.
I have a table and I managed to apply a filter to the <> "sent" column and I would like to export what is <> SENT and fill that column with the text sent to not send again.
the filter I can apply but I was able to export to another workbook but the filter is not applied.
Any idea .
Difficulties: Export filtered table and fill what is exported with Sent text.
THX.
Comment by: Jan Karel Pieterse (29-5-2020 18:55:00) deeplink to this comment
Hi João,
Have you already written some VBA code? If so, perhaps you can post that here and indicate what bit of it does not work as expected?
Comment by: João Figueiredo (29-5-2020 19:12:00) deeplink to this comment
''' Copy and Export
' Filter first for check if existe new rows do sent(2 conditions);
Dim Xra As ListObject
Set Xra = Sheet1.ListObjects(1)
Xra.Parent.Activate
'1. Apply Filter
Xra.Range.AutoFilter Field:=6, Criteria1:="ON_URG"
Xra.Range.AutoFilter Field:=26, Criteria1:=""
Dim myRangex As Double
On Error Resume Next
myRangex = Xra.DataBodyRange.SpecialCells(xlCellTypeVisible).count ' COunt how many rows are!
On Error GoTo 0
If myRangex < 1 Then
MsgBox "Não tem existe entregas novas, verifique ficheiro consumos(txt)"
Exit Sub
Else
' if OK THEN GO to Copy and export
' same filter aplied, but now to copy and export to same folder
Dim Dxprt As String
Dxprt = Format(Now(), "yyyymmddhhmm")
Dim lo As ListObject
Set lo = Sheet1.ListObjects(1)
lo.Parent.Activate 'Activate sheet that Table is on.
lo.AutoFilter.ShowAllData
'1. Apply Filter
lo.Range.AutoFilter Field:=6, Criteria1:="ON_URG"
lo.Range.AutoFilter Field:=26, Criteria1:=""
Dim wb As Workbook, wbNew As Workbook
Dim ws As Worksheet, wsNew As Worksheet
Dim wbNewName As String
Set wb = ThisWorkbook
Set ws = ActiveSheet
Set wbNew = Workbooks.Add
With wbNew
Set wsNew = wbNew.Sheets("Sheet1")
wbNewName = "CdT_On_Urg" & Dxprt
' ws.ListObjects(1).Range.COPY ' myRange
lo.Range.SpecialCells(xlCellTypeVisible).COPY ' myRange
wsNew.Range("A1").PasteSpecial Paste:=xlPasteAll
.SaveAs Filename:=wb.Path & "\" & wbNewName & ".xlsx", _
FileFormat:=xlWorkbookDefault, CreateBackup:=False
End With
ActiveWorkbook.Close
MsgBox "ficheiro Exportado para a pasta" ' OK Done!!
End If
End Sub
Comment by: João Figueiredo (29-5-2020 19:14:00) deeplink to this comment
thanks!!! the only thing than is missing is the part to fill the column with the text "sent",
Sub COPYS()
''' Copy and Export
' Filter first for check if existe new rows do sent(2 conditions);
Dim Xra As ListObject
Set Xra = Sheet1.ListObjects(1)
Xra.Parent.Activate
'1. Apply Filter
Xra.Range.AutoFilter Field:=6, Criteria1:="ON_URG"
Xra.Range.AutoFilter Field:=26, Criteria1:=""
Dim myRangex As Double
On Error Resume Next
myRangex = Xra.DataBodyRange.SpecialCells(xlCellTypeVisible).count ' COunt how many rows are!
On Error GoTo 0
If myRangex < 1 Then
MsgBox "Não tem existe entregas novas, verifique ficheiro consumos(txt)"
Exit Sub
Else
' if OK THEN GO to Copy and export
' same filter aplied, but now to copy and export to same folder
Dim Dxprt As String
Dxprt = Format(Now(), "yyyymmddhhmm")
Dim lo As ListObject
Set lo = Sheet1.ListObjects(1)
lo.Parent.Activate 'Activate sheet that Table is on.
lo.AutoFilter.ShowAllData
'1. Apply Filter
lo.Range.AutoFilter Field:=6, Criteria1:="ON_URG"
lo.Range.AutoFilter Field:=26, Criteria1:=""
Dim wb As Workbook, wbNew As Workbook
Dim ws As Worksheet, wsNew As Worksheet
Dim wbNewName As String
Set wb = ThisWorkbook
Set ws = ActiveSheet
Set wbNew = Workbooks.Add
With wbNew
Set wsNew = wbNew.Sheets("Sheet1")
wbNewName = "CdT_On_Urg" & Dxprt
' ws.ListObjects(1).Range.COPY ' myRange
lo.Range.SpecialCells(xlCellTypeVisible).COPY ' myRange
wsNew.Range("A1").PasteSpecial Paste:=xlPasteAll
.SaveAs Filename:=wb.Path & "\" & wbNewName & ".xlsx", _
FileFormat:=xlWorkbookDefault, CreateBackup:=False
End With
ActiveWorkbook.Close
MsgBox "ficheiro Exportado para a pasta" ' OK Done!!
End If
End Sub
Comment by: João Figueiredo (29-5-2020 19:15:00) deeplink to this comment
hello.. where did my text and VB go?? :)
Comment by: Jan Karel Pieterse (30-5-2020 11:23:00) deeplink to this comment
Hi Joao,
comments are not published automatically, I have to approve them (which I just did)
Comment by: João Figueiredo (30-5-2020 11:53:00) deeplink to this comment
Sorry:) i didin´t know.
Comment by: Jan Karel Pieterse (30-5-2020 11:54:00) deeplink to this comment
Hi Joao,
Filling the visible cells of a table column with a value is simple:
Have a question, comment or suggestion? Then please use this form.
If your question is not directly related to this web page, but rather a more general "How do I do this" Excel question, then I advise you to ask your question here: www.eileenslounge.com.