Scribd
Upload
115 views

Listobject Tables - Essential Pointers For Vba Created and Compiled by Bhaskar. Dated 23.03.2021

The document provides code snippets for working with ListObject Tables in VBA. It explains how to find the number of filled rows in a table by getting the header row number and last filled row number. It also shows how to copy rows from one table to another table on a different sheet, and includes a function to format the copied row by clearing the rank and incrementing the number.

Uploaded by

vaskore
Copyright
© © All Rights Reserved
Available Formats
Download as PDF, TXT or read online on Scribd
115 views

Listobject Tables - Essential Pointers For Vba Created and Compiled by Bhaskar. Dated 23.03.2021

The document provides code snippets for working with ListObject Tables in VBA. It explains how to find the number of filled rows in a table by getting the header row number and last filled row number. It also shows how to copy rows from one table to another table on a different sheet, and includes a function to format the copied row by clearing the rank and incrementing the number.

Uploaded by

vaskore
Copyright
© © All Rights Reserved
Available Formats
Download as PDF, TXT or read online on Scribd
You are on page 1/ 4

ListObject Tables - Essential Pointers for VBA

Created and compiled by Bhaskar. Dated 23.03.2021


Mail ID : [email protected]

Finding the number of filled rows in Table ListObject :

1. Create a table ListObject by first activating the sheet of the particular


table followed by setting the table object
2. Find the row number of Table header row
3. Find the row number of Table Data body Range last filled row
4. Subtract the header row number from the table last filled row number
to get the number of filled rows within the data body range

Code snippet 1:

Dim rownum As Integer


Dim HRow As Integer ‘Row number of the Header Row
Dim LastRow as Integer
Dim Rowcount as Integer
Dim Table As ListObject

‘Check table name by clicking on Formulas tab followed by clicking on Define Name
Worksheets(Range("Table3").Worksheet.Name).Activate
Set Table = Worksheets(Range("Table3").Worksheet.Name).ListObjects("Table3")

Set destcell = Range("Table3").ListObject.DataBodyRange(1,


1).End(xlDown).Offset(1, 0)

‘Row number of the Header Row


HRow = Table.HeaderRowRange.Row

‘Row number of the LastRow of Table ListObject


LastRow = Table.DataBodyRange.Cells(1,1).End(xlDown).Row

'Number of filled rows in the databody range of table


Rowcount = LastRow - HRow

References :
1. https://exceloffthegrid.com/vba-excel-tables-code/
2. https://www.thespreadsheetguru.com/blog/2014/6/20/the-vba-guide-to-listobject-
excel-tables
3. https://www.dingbatdata.com/2017/11/24/referencing-listobjects-with-vba/ (Little
bit tricky. Certain excerpts may not necessarily hold true due to version changes.)
4. http://dailydoseofexcel.com/archives/2017/07/29/inconsistent-listrow-copy/ - Do
not use the listrow.copy method while copying values from table DataBodyRange
range to another.

Code snippet 2:

Sub Copy_Active_Former()

'1. A row inside the table in "ActivePlayers" sheet has to be shifted to the
"FormerPlayers" sheet
'to the next available row in a similar table.

'2. The Row copied will append to next available row in "FormerPlayers" Sheet. Rank
data of the
'copied row tone deleted, number column assigned incrementally and the table in
"FormerPlayers"
'to be sorted by number column. (All steps are in code except sorting - which did not
seem necessary)

Dim RowCount As Integer, strtrow As Integer, EndRow As Integer, HRow As Integer


Dim CopyRng As Range
Dim Table As ListObject
Dim x As Boolean
Dim y As Boolean
Dim destcell As Range

Dim UserRange As Range


Set UserRange = SelectRange

If UserRange Is Nothing Then Exit Sub


'Note cannot use If UserRange = Nothing

Dim TableName As String


TableName = "Table2"

Set Table = Range(TableName).ListObject

x = Overlap(UserRange, TableName, RowCount, strtrow, EndRow, HRow)

If x = True Then

Set CopyRng = Table.Range.Rows(CStr(strtrow - HRow + 1) & ":" &


CStr(EndRow))
CopyRng.Copy

Set destcell = Range("Table3").ListObject.DataBodyRange(1,


1).End(xlDown).Offset(1, 0)
'VBA error 1004 - select method of range class failed
destcell.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Call
FormerPlayerSht(Worksheets(destcell.Worksheet.Name).Range(destcell.Address))
'Need to be careful when passing range as argument to function

Call
ActivePlayerSht(Worksheets(CopyRng.Worksheet.Name).Range(CopyRng.Address)
)
MsgBox "Transfer successfully done !!"
Else
MsgBox "Select rows overlapping with table"
End If

End Sub

Code Snippet 3:

Private Sub FormerPlayerSht(ByRef cell As Range)


'formatting adjusted in the added row
'Rank value cell cleared
'Number added incrementally (1 more than the immediate cell above)

'-----------------------------------------------------------------------------------------------------------

Dim rownum As Integer, HRow As Integer


Dim Table As ListObject
Dim LastRow1 As Range 'Last row before pasting data
'Dim LastRow2 As Range 'Last row after pasting data - Redundant

‘Check table name by clicking on Formulas tab followed by clicking on Define Name

Worksheets(Range("Table3").Worksheet.Name).Activate
Set Table = Worksheets(Range("Table3").Worksheet.Name).ListObjects("Table3")
Set LastRow1 = cell.Offset(-1, 0)

HRow = Table.HeaderRowRange.Row ‘Row number of the Header Row


rownum = cell.Offset(-1, 0).Row

Table.HeaderRowRange.Cells(1, 1).Offset(rownum - HRow).Resize(1,


Table.ListColumns.Count).Copy

Table.HeaderRowRange.Cells(1, 1).Offset(rownum - HRow + 1).PasteSpecial


Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

With Table.DataBodyRange(cell.Row - HRow, 2)


.FormulaR1C1 = "=R[-1]C+1"
.Offset(0, 1).ClearContents
End With

End Sub

You might also like