Add Total Row to Existing List Object using Excel VBA
Sub Add_TotalRow_2_ExistingTable()
Dim oWS As Worksheet ' Worksheet Object
Dim oRange As Range ' Range Object - Contains Represents the List of Items that need to be made unique
Dim oLst As ListObject ' List Object
Dim oLC As ListColumn ' List Column Object
On Error GoTo Disp_Error
' ---------------------------------------------
' Coded by Shasur for www.vbadud.blogspot.com
' ---------------------------------------------
oWS = ActiveSheet
If oWS.ListObjects.Count = 0 Then Exit Sub
oLst = oWS.ListObjects(1)
oLst.ShowTotals = True
' Change/Set the formatting of the Totals Row
oLst.TotalsRowRange.Font.Bold = True
oLst.TotalsRowRange.Font.Color = vbRed
If Not oLC Is Nothing Then oLC = Nothing
If Not oLst Is Nothing Then oLst = Nothing
If Not oWS Is Nothing Then oWS = Nothing
' --------------------
' Error Handling
' --------------------
Disp_Error:
If Err <> 0 Then
MsgBox(Err.Number & " - " & Err.Description, vbExclamation, "VBA Tips & Tricks Examples")
Resume Next
End If
End Sub
getting error in
ReplyDeleteoWS = ActiveSheet
The code is wrong. Objects need to use Set.
ReplyDeleteSet oWS = ActiveSheet
Likewise with the ListObjects