Hi, i have some code that
a) filters data from the table in one sheet into a group of new sheets named by the filter value
b) creates a new workbook from these sheets
The script does the above. The additional code has no effect that i can see. It doesnt stop it working, it just doesnt do anything.
I am trying to stick some code in between that turns the data on the sheets into tables before it copies them to a separate workbook (and preserve the tables of course).
I am also trying to name the table according to the sheet name and then add the total rows.
I have the code for adding a table, naming it (not according to the sheet name) and adding the total rows working on a one sheet version. But on this multi sheet method i cant get it to do anything.
I am doing it while the sheets are still in the original workbook because i figure it might be easier than trying to turn the data into tables when it is a separate workbook, but if it is easier, i have no preference.
I will paste the code section followed by the whole code including the secretion, which i have marked.
I would really appreciate someone showing me how to do this. A little explanation would also be great as I am trying my best to figure out how it actually works.
Full code ......
a) filters data from the table in one sheet into a group of new sheets named by the filter value
b) creates a new workbook from these sheets
The script does the above. The additional code has no effect that i can see. It doesnt stop it working, it just doesnt do anything.
I am trying to stick some code in between that turns the data on the sheets into tables before it copies them to a separate workbook (and preserve the tables of course).
I am also trying to name the table according to the sheet name and then add the total rows.
I have the code for adding a table, naming it (not according to the sheet name) and adding the total rows working on a one sheet version. But on this multi sheet method i cant get it to do anything.
I am doing it while the sheets are still in the original workbook because i figure it might be easier than trying to turn the data into tables when it is a separate workbook, but if it is easier, i have no preference.
I will paste the code section followed by the whole code including the secretion, which i have marked.
I would really appreciate someone showing me how to do this. A little explanation would also be great as I am trying my best to figure out how it actually works.
Code:
'----------------------------------------------------------------------------------------------------------------------------------------------------------------------'Start of code section that does not work
'create named tables on each sheet with total rows
For Each ws In ThisWorkbook.Worksheets
Select Case ws.Name
Case "Dashboard", "Expenses", "CCRead", "INVRead" 'list the sheets NOT to be worked on
Case Else
With Workbooks("Expenses.xlsm")
LastRow = ws.Range("M" & Rows.Count).End(xlUp).Row
Range("A1:M20").Select
'Range("A" & Lastrow, "M" & Lastrow).Select
.ListObjects.Add(1, .Cells(1).CurrentRegion, , 1).Name = "TCCRecords" & ActiveSheet.Name
Columns("K").ColumnWidth = 25
Set listob = ws.ListObjects(1)
listob.ShowTotals = True
With ws.ListObjects("TCCRecords" & ActiveSheet.Name)
.ListColumns("Value Excluding VAT £").TotalsCalculation = xlTotalsCalculationSum
.ListColumns("VAT Value £").TotalsCalculation = xlTotalsCalculationSum
.ListColumns("Total Value £").TotalsCalculation = xlTotalsCalculationSum
.ListColumns("Cost Centre").TotalsCalculation = xlTotalsCalculationNone
Range("A1").Select
End With
End With
End Select
Next
'end of code section that does not work
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------Full code ......
Code:
Sub NewNamedWorkbook()
Dim NewName As String
Dim LastRow As Long
Dim strFile As String
Dim listob As ListObject
If MsgBox("Filter range to a new workbook?" _
, vbYesNo, "NewCopy") = vbNo Then Exit Sub
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
With Application
retry:
'Input box to name new file
NewName = InputBox("Please Specify the name of your new workbook")
If StrPtr(NewName) = 0 Then
MsgBox ("User canceled!")
GoTo reset
Else
End If
'VBA Check if File Exists
strFile = ThisWorkbook.Path & "\" & NewName & ".xlsx"
If FileExists(strFile) Then
'File Exists
MsgBox "The filename you have chosen already exists, please choose a unique filename"
GoTo retry
Else
End If
End With
Set NewBook = Workbooks.Add
With NewBook
.title = NewName 'name of new workbook
.Subject = "Expenses In WorkSheets arranged by Cost Centre or Task Code"
' Save it with the NewName and in the same directory as the tool
.SaveAs ThisWorkbook.Path & "\" & NewName & ".xlsx"
End With
Call columntosheets 'filter column and copy to separate sheets
'----------------------------------------------------------------------------------------------------------------------------------------------------------------------
'Start of code section that does not work
'create named tables on each sheet with total rows
For Each ws In ThisWorkbook.Worksheets
Select Case ws.Name
Case "Dashboard", "Expenses", "CCRead", "INVRead" 'list the sheets NOT to be worked on
Case Else
With Workbooks("Expenses.xlsm")
LastRow = ws.Range("M" & Rows.Count).End(xlUp).Row
Range("A1:M20").Select
'Range("A" & Lastrow, "M" & Lastrow).Select
.ListObjects.Add(1, .Cells(1).CurrentRegion, , 1).Name = "TCCRecords" & ActiveSheet.Name
Columns("K").ColumnWidth = 25
Set listob = ws.ListObjects(1)
listob.ShowTotals = True
With ws.ListObjects("TCCRecords" & ActiveSheet.Name)
.ListColumns("Value Excluding VAT £").TotalsCalculation = xlTotalsCalculationSum
.ListColumns("VAT Value £").TotalsCalculation = xlTotalsCalculationSum
.ListColumns("Total Value £").TotalsCalculation = xlTotalsCalculationSum
.ListColumns("Cost Centre").TotalsCalculation = xlTotalsCalculationNone
Range("A1").Select
End With
End With
End Select
Next
'end of code section that does not work
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------
For Each ws In ThisWorkbook.Worksheets
Select Case ws.Name
Case "Dashboard", "Expenses", "CCRead", "INVRead" 'list the sheets NOT to copy
Case Else
'copy here
With Workbooks("Expenses.xlsm")
'ws.Copy After:=.Sheets(.Sheets.Count) 'copys after last sheet
ws.Copy Before:=Workbooks(NewName & ".xlsx").Sheets(1)
End With
End Select
Next
Workbooks(NewName & ".xlsx").Activate
Application.DisplayAlerts = False
Sheets("Sheet1").Delete
Application.DisplayAlerts = True
'delete the sheets from the main workbook
For Each ws In ThisWorkbook.Worksheets
Select Case ws.Name
Case "Dashboard", "Expenses", "CCRead", "INVRead" 'list the sheets NOT to copy
Case Else
'copy here
With Workbooks("Expenses.xlsm")
'ws.Copy After:=.Sheets(.Sheets.Count) 'copys after last sheet
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
End With
End Select
Next
Exit Sub
reset:
'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Last edited:
