I am currently attempting to optimize some code. Currently, I use ActiveWorkbook.RefreshAll which slows the whole run time down significantly, in actual fact I only need to refresh two worksheet in the workbook. Does a function such as Worksheet("Name").RefreshAll exist? I am aware of .calculate, but I don't think it will update my pivot tables as well as calculation in the given sheets.
Regards
Why not loop through your workbook, and on those specific sheets, calculate and refresh the pivot table? If the tables aren't on the same sheet, you can tweak the code to loop through pivot tables and refresh that way, instead of within the "each sheet" loop.
Sub t()
Dim ws As Worksheet
Dim pvt As PivotTable
For Each ws In ActiveWorkbook.Worksheets
If ws.Name = "Sheet4" Or ws.Name = "Sheet2" Then
ws.Calculate
For Each pvt In ws.PivotTables
pvt.RefreshTable
Next pvt
End If
Next ws
End Sub
Related
I am attempting to loop through multiple tables within a single workbook and clear the data on those tables so that new data can be entered. As the row counts, column counts, names, and number of tables can change I was hoping to create a single macro to loop through the tables and perform .DataBodyRange.Delete
Working Code for 1 table called by sheet and object name:
I also found this code on a forum and I believe the IF portion takes into account a table that is already empty so that no error is thrown.
Sub ResetTable()
With ThisWorkbook.Sheets("SheetName").ListObjects("ListObjectName")
If Not .DataBodyRange Is Nothing Then
.DataBodyRange.Delete
End If
End With
End Sub
My attempt at turning this into a more dynamic loop:
The second set of code is failing on With ws .tbl due to a Compile error: Method or data member not found. So I am looking for any help in either fixing the below code or using an entirely different path.
Sub ResetAllTables()
Dim tbl As ListObject
Dim ws As Worksheet
'Loop through each sheet and table in the workbook
For Each ws In ThisWorkbook.Worksheets
For Each tbl In ws.ListObjects
'Do something to all the tables...
With ws.tbl
If Not .DataBodyRange Is Nothing Then
.DataBodyRange.Delete
End If
End With
tbl.ShowTotals = True
Next tbl
Next sht
End Sub
Thanks in advance!
as suggested by BigBen & SRJ,
changing with ws.tbl to just with tbl fixed the issue. also had to fix Next sht to be Next ws
Thanks for the help!
I have a workbook that the workbook formatting is changed regularly, however once changed (maybe weekly or monthly) then going forward until it is changed again a macro needs to replicate that format. Changing the VBA to account for the new formatting each time is very time consuming. Is it possible to format a workbook and then copy the formatting easily to VBA (after the fact not like a macro record) for future use?
In the past I have since used a hidden sheet within the workbook where the macro runs and I essentially copy/paste that into the sheet I am working with. This works but has the downside of when making changes I first need to copy data over to the "template" sheet to ensure everything is correctly aligned with new data.
Possibly some kind of macro that iterates through all cells of a range and outputs to the immediate window the VBA code needed to re-create the formatting?
Basically any ideas will help :)
There are so many formatting options that simply storing them as separate options will take far more space than just a duplicate template sheet. Just run the first code to update your template, and the second to copy it back:
option Explicit
Const TemplatesheetName = "mytemplate"
Sub CopyFormatting
dim ws as worksheet
dim source as worksheet
set source = activesheet
for each ws in worksheets
if ws.name = templatesheetname then
exit for
end if
next ws
if ws is nothing then
set ws = worksheets.add
ws.name = templatesheetname
end if
ws.usedrange.clearformats
source.usedrange.copy
ws.range("a1").pastespecial xlpasteformats
ws.visible = xlveryhidden
end sub
Sub BringBackFormats
dim ws as worksheet
for each ws in worksheets
if ws.name = templatesheetname then
exit for
end if
next ws
if ws is nothing then
msgbox "No template found",vbokonly,"Unabl;e to run"
else
ws.cells.copy
activesheet.range("a1").pastespecial xlpasteformats
end if
exit sub
(written on my phone, can't check the code, there may be typos)
I have a pivot table in my Sheet1 connected to external sources which is also an excel sheet. All i am trying to do is to get a date and time stamp whenever someone refreshes pivot table.
I get an error Object doesn't support this property or method.
Private Sub Refresh_Click()
Dim PT As PivotTable
Dim WS As Worksheet
For Each WS In ThisWorkbook.Worksheets
For Each PT In WS.PivotTables
PT.RefreshTable
WS.Sheets("Month-to-Date").Range("P5") = TimeValue(Now)
Next PT
Next WS
End Sub
The problem is that WS is a Worksheet and a Worksheet does not support another Worksheet as a property.
Worksheets are properties of Workbooks so
ThisWorkbook.Sheets("Month-to-Date").Range("P5") = TimeValue(Now)
Fixes the problem
There is a fancy built-in event in Excel VBA for this. In the worksheet of the pivot table, select the event PivotTableUpdate (Event Documentation):
As far as probably there would be more than 1 pivot tables on the worksheet, it is a good idea to check which one is the refreshed one, using its name:
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
Select Case Target.Name
Case "PivotTable2"
Debug.Print "Write date somewhere "; Format(Now, "DD-MM-YYYY")
Case Else
Debug.Print "Not PivotTable2"
End Select
End Sub
"DateStamp" is obtained through Format(Now, "DD-MM-YYYY") and printed to the immediate window (Ctrl+G). Instead of printing there, it is a possible option to write it to a server or to a separate worksheet, getting the last cell of a row like this:
Case "PivotTable2"
Worksheets(2).Cells(lastCell, 1) = Format(Now, "DD-MM-YYYY")
I have a workbook with 84 worksheets all with different amounts of rows of data.
I need to convert all of the worksheets data to tables.
I found this macro online which I thought would work if I had all of the sheets selected but it doesn't.
Sub A_SelectAllMakeTable2()
Dim tbl As ListObject
Set tbl = ActiveSheet.ListObjects.Add(xlSrcRange, Selection, , xlYes)
tbl.TableStyle = "TableStyleMedium15"
End Sub
Is there a way to modify this so it will affect the entire workbook?
You could use something like this:
Sub A_SelectAllMakeTable2()
Dim ws as worksheet
for each ws in activeworkbook.worksheets
ws.ListObjects.Add(xlSrcRange, ws.range("A1").Currentregion, , xlYes).TableStyle = "TableStyleMedium15"
next ws
End Sub
I'm working on an XL workbook that has multiple tables on multiple sheets. As I go along, I've been adding to and modifying a subroutine that can zeroise the tables. This is time consuming (and error-prone), especially as I keep having to modify my tables at the whim of my beloved users. Can anyone come up with a routine that will just find each table and zeroise it?
Many thanks.
This will loop through each table in your workbook and set all values to 0
Public Sub PopulateTables()
Dim ws As Worksheet
Dim tbl As ListObject
For Each ws In ThisWorkbook.Sheets
For Each tbl In ws.ListObjects
tbl.DataBodyRange.Value2 = 0
Next tbl
Next ws
End Sub