Enabling the Total Row via Macro

[Folksteve]

Hello,

I've built the below Macro to take information from one sheet and put it into a new workbook as a Table.

Problem is I need to add a total row and when I go the usual route of 'ActiveSheet.ListObjects("Table1").ShowTotals = True' I get 'Run-time error '1004': Application-defined or Object-defined error'

Sub Generate_New_Sheet()
'Change to the relevant sheet'
'Create a new workbook with the relevant sheet'
ThisWorkbook.Sheets("Sheet2").Copy
'Save the new workbook to the Desktop'
ActiveWorkbook.SaveAs Filename:=Environ("USERPROFILE") & "\Desktop\" & "TEST - " & Format(Now, "dd-mm-yy"), FileFormat:=xlOpenXMLWorkbook
'Pause Screen Updating'
Application.ScreenUpdating = False
'Delete All Comments'
Cells.Select
Selection.ClearComments
'Unprotect Sheet'
ActiveSheet.Unprotect
'Modify Header & Footer'
ActiveSheet.PageSetup.CenterHeader = "DATA"
ActiveSheet.PageSetup.CenterFooter = ""
ActiveSheet.PageSetup.RightFooter = "&D"
'Delete Unecessary Columns'
Columns("B:I").EntireColumn.Delete
Columns("C").EntireColumn.Delete
Columns("H").EntireColumn.Delete
'Delete Blank Rows based on Weight Column'
Range("D:D").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
'Delete Stored Data Rows'
Rows("2:195").EntireRow.Delete
'Change to Text'
[A1].Value = "'Text"
'Unfreez Panes'
ActiveWindow.FreezePanes = False
'Set Zoom'
ActiveWindow.Zoom = 125
'Show ONLY Active Rows'
lcol = Cells(1, Columns.Count).End(xlToLeft).Column
lrow = Cells(Rows.Count, "D").End(xlUp).Row
Range(Cells(1, lcol + 1), Cells(Rows.Count, Columns.Count)).EntireColumn.Hidden = True
Range(Cells(lrow + 1, 1), Cells(Rows.Count, Columns.Count)).EntireRow.Hidden = True
'Select Active Cells'
Range("A:G").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
'Create Table'
Dim tbl As ListObject
Set tbl = ActiveSheet.ListObjects.Add(xlSrcRange, Selection, , xlYes)
tbl.TableStyle = ""
ActiveSheet.ListObjects("Table1").ShowTotals = True
'Set Print Area'
Dim LR As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
With ActiveSheet.PageSetup
.Orientation = xlPortrait
.FitToPagesWide = 1
.FitToPagesTall = 1
.PrintArea = Range("A1" & LR).SpecialCells(xlCellTypeVisible).Address
End With
'Move back to cell A1'
Range("A1").Select
'Reactivate Screen Update'
Application.ScreenUpdating = True
End Sub


Thanks for any help you can give

 

[Jeffrey Mahoney]

It worked for me if I change that line to read:

tbl.ShowTotals = True

Jeff

 

[Folksteve]

Thanks Jeff, I'm afraid I'm getting the same error using tbl.ShowTotals = True

I'm using Excel 2007 if that helps.

 

[Jeffrey Mahoney]

Puzzling. I don't know why.