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
Related
I have a problem with a vba macro that i can't seem to find the answer to anywhere. Feels like i've tried everyting so i'll put the question out there to see if anyone here can help me :)
My macro loops through 50 woorkbooks that all have a "Firstpage" where the data from all the other data worksheets are summarized. In that Firstpage i have a table called "Tabell_1". The table has a header row (B4:F4) and then one row for each data worksheet in the workbook and the a sum row. We have decided to add a new column (column D) to the table to add in data from a specific cell in all the other worksheets (B4).
I now loop through the data worksheets to copy the value in B4 and then i want to paste that value to the first empty row in the table on the "Firstpage" (starting from the cell under the header). The method to find the last row that i use in other parts of the macro doesn't work, it gives me the first row after the sum row and then pastes the values under the table.
The picture shows the table that i'm working with for one of the workbooks.
enter image description here
Hej Johanna!
Assuming that you are using listobjects to manage the data I would just do this..
Sub Test2()
Dim lo As ListObject
Dim lr As ListRow
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1")
Set lo = ws.ListObjects("Tabell_1")
Count = 1
For Each lr In lo.ListRows
If lo.ListColumns("Test2").DataBodyRange(lr.Index) = "" Then
lo.ListColumns("Test2").DataBodyRange(lr.Index) = Count
Count = Count + 1
End If
Next lr
End Sub
This is will fill the first empty row in column Test2.
Hopefully you can use this example :)
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 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?
As part of my project I have a Table which includes lookup formulas in each column that are dragged down the whole table. Depending on the case only the first x rows return values. I included an iferror so that the lookups that don't return values return "".
Now I want to copy the rows of the table that return values to the first empty row in a different table in a different worksheet.
The code I have so far:
Sub Copy_Results()
Application.ScreenUpdating = False
Dim copySheet As Worksheet
Dim pasteSheet As Worksheet
Set copySheet = Worksheets("Sheet1")
Set pasteSheet = Worksheets("Sheet2")
copySheet.Range("Table1").Copy
pasteSheet.ListObjects("Table2").Range.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Now the big problem is that I want to be able to execute this macro multiple times, each time the values from Table 1 should be pasted below the preexisting values in table 2.
The point being that each time the lookup values change meaning I get new results I want to paste them in a table where all the results are documented.
Issues that I had so far:
The first Copy Paste usually works, but when I copy again the values get pasted way below the first ones outside of the table. Usually the full length of the table away. I guess this is because the whole copy table is filled with formulas.
The easiest way to do this is to restrict the cells that you are going to copy using the SpecialCells method:
https://msdn.microsoft.com/en-us/library/office/ff196157.aspx
In this case you only want to copy the formulas that have numbers as the values, so this would be the syntax:
SpecialCells(xlCellTypeFormulas, xlNumbers)
Put into your code it would be:
copySheet.Range("Table1").SpecialCells(xlCellTypeFormulas, xlNumbers).Copy
You can see this in action outside of your code by selecting the complete range in your source sheet then pressing F5, selecting the "Special" button at the bottom of the dialog that pops up, then select "Formulas" and "Numbers".
To make sure it pastes in the next available row, use the CurrentRegion property:
https://msdn.microsoft.com/en-us/library/office/ff196678.aspx?f=255&MSPPError=-2147217396
This code will tell you what the last row is in the used area defined by cell A1:
pasteSheet.cells(1,1).CurrentRegion.Rows.Count
I believe the paste command you're looking for will be close to this (hard to test exactly without your spreadsheet):
pasteSheet.cells(pasteSheet.cells(1,1).CurrentRegion.Rows.Count + 1, 1).PasteSpecial xlPasteValues
I am trying to create a Stacked Column Chart with the data in the table below.
I want to Select column A1:A9 and C1:F9. The Selection also needs to be adaptive to different column sizes (i.e, someone adds another Feature). The macro should also work for a table of data, anywhere in the Sheet. As long as the macro originates from the ActiveCell.
How do I not only Select until the column end, but also Select excluding the "Values" column. I am trying to use End and Offset, but I am not sure the best way to do it. And once again, I want to use it on a table that is anywhere in the sheet and then create a Stacked Column Chart from it.
Thanks for your help!
Try this code please. The idea is that you iteratively Union various ranges of the data based on the condition that the header is not 'Values'.
The working assumption is that the CurrentRegion of the ActiveCell will select your table data. Where the definition of CurrentRegion is 'The current region is a range bounded by any combination of blank rows and blank columns. ' - MSDN link
Then the code will append the first column to an output range. After that, the outer columns will only be appended to the output range if the header is not 'Values'.
Dim rngData As Range
Dim intCounter As Integer
Dim rngToSelect As Range
Set rngData = ActiveCell.CurrentRegion
Set rngToSelect = Range(rngData.Cells(1, 1), rngData.Cells(rngData.Rows.Count, 1))
For intCounter = 1 To rngData.Columns.Count
If rngData.Cells(1, intCounter).Value <> "Values" Then
Set rngToSelect = Union(rngToSelect, Range(rngData.Cells(1, intCounter), rngData.Cells(rngData.Rows.Count, intCounter)))
End If
Next intCounter
rngToSelect.Select