I have an Excel document which pulls data from an Access database.
From here, the data is summarised in a Pivot Table.
It is then pulled into another table which makes it easier to read and filter.
The last table is formatted as a table and formulas are in place.
Depending on the data in the database, this table can reduce or expand the number of rows when refreshed.
When I run the macro to refresh the data and tables, I want to be able to automatically resize the table so all of the data is shown, but no extra blank rows appear at the bottom.
So far, I have the following code which looks up the Pivot Table sheet (Pivot) to determine the number of rows to display in the output sheet (Report):
Sub ResizeList()
Dim ws As Worksheet
Dim ob As ListObject
Dim Lrow1 As Long
Lrow1 = Sheets("Pivot").Cells(Rows.Count, "A").End(xlUp).Row
Set ws = ActiveWorkbook.Worksheets("Report")
Set ob = ws.ListObjects("Report_Table")
ob.Resize ob.Range.Resize(Lrow1)
End Sub
However, it only removes the table formatting (not the data) from the extra rows at the bottom when the table reduces in size.
Also, I get too many rows in the Report Table because of the header and total rows in the pivot.
Can someone help?
Related
I'm new to using VBA and need to copy data from a range of cells on one worksheet to another worksheet. I need to copy a column of cells and paste it into a row of cells e.g. A1:A4 to A1:D1. This is the code i'm using but it doesn't work the way i need it too.
Sub Draft()
Worksheets("Material Check").Range("B3:B6").Copy _
Destination:=Worksheets("Archive").Range("A2:D2")
End Sub
Also I need the data thats being copied over to be added to the bottom of the table on the archive sheets and i'm not sure how to do this.
Without Excel Tables
This is a bit of an odd way to do it but if you have a lot of cells to do, it's possibly faster than copy/paste special:
ThisWorkbook.Worksheets("Archive").Range("A2:D2").Formula = "=INDEX('Material Check'!$B$3:$B$6,Column())"
ThisWorkbook.Worksheets("Archive").Range("A2:D2").Value = ThisWorkbook.Worksheets("Archive").Range("A2:D2").Value
The first line populates the destination range with a formula that pulls the data from the source, using INDEX/COLUMN to transpose the result.
The second line simply converts the formula to hard values.
EDIT - Solution to copy the values to the bottom of the list
Using Excel Table
To do this you will need to go to "Insert" --> "Table".
''Get a reference to your destination table
Dim Tbl1 As ListObject
Set Tbl1 = ThisWorkbook.Sheets("Archive").ListObjects("Table1") ''Change these to your destination sheet/table names
''add a new row to the table
Dim Newrow As ListRow
Set Newrow = Tbl1.ListRows.Add
''populate the new row
With Newrow
.Range(Tbl1.ListColumns("Column1").Index) = ThisWorkbook.Worksheets("Material Check").Range("B3") ''change these to your destination column name and your source sheet/ranges
.Range(Tbl1.ListColumns("Column2").Index) = ThisWorkbook.Worksheets("Material Check").Range("B4")
.Range(Tbl1.ListColumns("Column3").Index) = ThisWorkbook.Worksheets("Material Check").Range("B5")
.Range(Tbl1.ListColumns("Column4").Index) = ThisWorkbook.Worksheets("Material Check").Range("B6")
End With
I am trying to check values of rows across all columns. My code filters and loop on each category. These data are copied on a certain format to another sheet and will be used as vlookup data. However, there are instances when I change a filter those row data don't have column data. Thus, The column header with no data does not show up in the pivot. I want these columns to show even if filtered. In normal Pivot table, there is "show items with no data" which will do these function. But in OLAP pivot, this option is greyed out. Tried below code but still did not work.
Are there any ways to do this? Appreciate your help on this. Thanks!
Sub DisplayEmptyMembers()
Dim pvtTable As PivotTable
Set pvtTable = ActiveSheet.PivotTables("WeeklySTCperFF")
pvtTable.DisplayEmptyColumn = True
pvtTable.DisplayEmptyRow = True
End Sub
I have three rows of data placed just after a pivot table. I am trying to create a single process to cut that data, prior to a pivot table refresh and then paste after the pivot table has been refreshed. The pivot table occupies columns B-I, and the cells occupy the same columns. I have one row of separation between the end of the pivot table and the three rows of data.
Well, this is one of those things that's tricky because you need to know how big the pivot will get after the refresh, but you need to know it before it refreshes.
I think you might as well just insert a bunch of rows between your data and the pivot, refresh the pivot safely, and then remove the extra rows.
Sub RefreshButPreserveFooterRows()
Dim pt As PivotTable
Dim PivotOriginalEndPosition As Integer
Dim PivotRefreshedEndPosition As Integer
Dim safetyGap
'pick how many rows you want to insert. Might as well be generous.
safetyGap = 100
Set pt = ActiveSheet.PivotTables("PivotTable1")
'Deterimine the position of the first row after your pivot table prior to refresh
PivotOriginalEndPosition = pt.RowRange.Rows.Count + pt.RowRange.Row
'Insert howerver many rows you specified as "Safety Gap" between your pivot and your data
Rows(PivotOriginalEndPosition & ":" & PivotOriginalEndPosition + safetyGap).Insert Shift:=xlDown
'refresh the pivot
pt.RefreshTable
'Deterimine the position of the first row after your pivot table after to refresh
PivotRefreshedEndPosition = pt.RowRange.Rows.Count + pt.RowRange.Row
'delete the extra rows from the safety gap, accounting for the new size of the pivot table
Rows(PivotRefreshedEndPosition & ":" & PivotOriginalEndPosition + safetyGap).Delete
End Sub
I have a pivot table with data, I need to copy and past all of the data except for the last row, which I need to delete as it is a sum of totals. The amount of data entries vary by week so I cannot just put the set numbers in. Currently my code looks like this;
Worksheets("Mobile Summary").Range("A4:F482").Copy
Worksheets("Sheet1").Range("A1:F479")
However I need to copy and paste more data from a different pivot table directly under this. Therefore I couldn't just set the rows to 3000 for example. I know there is a code to find the last row, although I'm coming up short as to how to go about solving this problem.
To find a pivot table by its name and remove the last row of the table use the Range.Resize property. This is useful if there is more than one pivot table on a worksheet.
Option Explicit
Sub CopyPivotTableWithoutLastRow()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Tabelle3")
Dim i As Long
For i = 1 To ws.PivotTables.Count 'loop throug all pivot tables
If ws.PivotTables(i).name = "PivotTable1" Then 'determine pivot table by its name
With ws.PivotTables(i).TableRange1 '= full table
.Resize(RowSize:=.Rows.Count - 1).Copy 'resize to remove last row then copy
End With
End If
Next i
End Sub
Excel 2013. I have pivot table, which grows and shrinks according to the data rows. For example,
1. For the Row label, I have list of all products
2. For the Column label, I have list of manufacturers
3. For the Values, I have a count of 1 for the manufacturer. This would tell me how many manufacturers produces the same product.
Therefore the product list (row) grows and so does the Manufacturer list (columns) expands.
My question: Is there a way to get the range of the pivot, for example if the pivot tables starts at A1 and there are 10 products and 10 manufacturers, then the range of the pivot table would be $A$1:$K$12 (without Total for row or Total for column).
Is there a quick way to extract the range $A$1:$K$12?
Thank you in advance,
G.
To get the pivot table range that doesn't include the filters range, which is usually two rows above the table, use this code. This will select the actual pivot table range, and output the address of the range of the pivot table in a msg box.
Set pt = ActiveSheet.PivotTables(1)
pt.TableRange1.select
Msgbox pt.TableRange1.address
I see you tagged Excel-VBA.
Yes if you are able to consider Range as Range(cells(1,1),cells(12,12)) instead of Range("A1:K12")
There is a way to count field items in VBA.
Rcount = Sheets("YOUR SHEET NAME").PivotTables(1).PivotFields("YOUR ROW NAME").PivotItems.Count
Ccount = Sheets("YOUR SHEET NAME").PivotTables(1).PivotFields("YOUR COL NAME").PivotItems.Count
From there you would need only add 2 to compensate for extra rows/columns
Rcount = Rcount+2
Ccount = Ccount+2
Dim TableRNG as range
Set TableRNG = Range(cells(1,1),cells(Rcount,Ccount))
Hard to go any further without knowing what you are trying to accomplish and im not sure you were really asking for a VBA solution.