I'd like some assistance with calling the subtotal function on a worksheet(Sheet3) from another one(Sheet1). When I pass the spreadsheet onto my user the following message occurs: Run-time error '1004': Subtotal method of Range class failed.
Let me start by stating that I don't know VBA. I'm trying to help a friend with a request to pull data from SQL (which I know) into Excel. I've cobbled together examples of VBA and it works at times and then throws errors at other times. I'm working on a solution for Excel 2010. The goal of the entire setup is to allow the user to select a name from a combo box which pulls data from SQL(into a hidden Sheet2) for the list. Enter a begin and end date and called a Stored Procedure in SQL with the 3 parameters and return a set of data. I have that working. Next it is desired the that resulting data be subtotaled by the date field in column A and that a blank line be inserted after each subtotal. Even though the code looks a mess, it is all working except that the subtotal call throws an occasional error. I've tried several methods of calling the subtotal, this last one seemed the most stable. Here's the code in which I remove existing Subtotals, Clear the Data from the Worksheet (3), Copy the table from the data retrieval from SQL on Sheet 1, Convert to a Range and then try to subtotal the data.
Private Sub CommandButton2_Click()
Application.ScreenUpdating = False
Worksheets(2).Activate
Cells.RemoveSubtotal
Sheets("Sheet3").UsedRange.ClearContents
Worksheets(1).ListObjects("Table__2GuyTest").Range.Copy _
Destination:=Worksheets(2).Range("A1")
Dim rList As Range
With Worksheets(2).ListObjects(1)
Set rList = .Range
.Unlist ' convert the table back to a range
End With
With Worksheets(2)
.Range("A1", "A50000").NumberFormat = "m/d/yyyy"
End With
Dim ws As Worksheet
For Each ws In Worksheets(Array("Sheet3"))
With ws.Range("A1")
.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(6), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
End With
Next ws
Columns("A:A").EntireColumn.AutoFit
Columns("B:B").EntireColumn.AutoFit
Columns("C:C").EntireColumn.AutoFit
Columns("D:D").EntireColumn.AutoFit
Columns("E:E").EntireColumn.AutoFit
Columns("F:F").EntireColumn.AutoFit
Call InsertBlankRow
Call RemoveRowColors
Application.ScreenUpdating = True
End Sub
Let me start by stating that I don't know VBA. I'm trying to help a friend with a request to pull data from SQL (which I know) into Excel. I've cobbled together examples of VBA and it works at times and then throws errors at other times. I'm working on a solution for Excel 2010. The goal of the entire setup is to allow the user to select a name from a combo box which pulls data from SQL(into a hidden Sheet2) for the list. Enter a begin and end date and called a Stored Procedure in SQL with the 3 parameters and return a set of data. I have that working. Next it is desired the that resulting data be subtotaled by the date field in column A and that a blank line be inserted after each subtotal. Even though the code looks a mess, it is all working except that the subtotal call throws an occasional error. I've tried several methods of calling the subtotal, this last one seemed the most stable. Here's the code in which I remove existing Subtotals, Clear the Data from the Worksheet (3), Copy the table from the data retrieval from SQL on Sheet 1, Convert to a Range and then try to subtotal the data.
Private Sub CommandButton2_Click()
Application.ScreenUpdating = False
Worksheets(2).Activate
Cells.RemoveSubtotal
Sheets("Sheet3").UsedRange.ClearContents
Worksheets(1).ListObjects("Table__2GuyTest").Range.Copy _
Destination:=Worksheets(2).Range("A1")
Dim rList As Range
With Worksheets(2).ListObjects(1)
Set rList = .Range
.Unlist ' convert the table back to a range
End With
With Worksheets(2)
.Range("A1", "A50000").NumberFormat = "m/d/yyyy"
End With
Dim ws As Worksheet
For Each ws In Worksheets(Array("Sheet3"))
With ws.Range("A1")
.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(6), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
End With
Next ws
Columns("A:A").EntireColumn.AutoFit
Columns("B:B").EntireColumn.AutoFit
Columns("C:C").EntireColumn.AutoFit
Columns("D:D").EntireColumn.AutoFit
Columns("E:E").EntireColumn.AutoFit
Columns("F:F").EntireColumn.AutoFit
Call InsertBlankRow
Call RemoveRowColors
Application.ScreenUpdating = True
End Sub
