I am trying to create a macro using VB that will convert many rows of data into a table. I want to store this macro and run it again and again. The one issue is that each time I will run it, there will be a different amount of rows.
The code I am using now is:
'CREATE NEW TABLE
Sub CreateTable2()
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$H$922"), , xlYes).Name = _
"MyNewTable2"
'No go in 2003
ActiveSheet.ListObjects("MyNewTable2").TableStyle = "TableStyleLight2"
End Sub
The above code will only go as far as '922' rows. I am looking for a way that can adjust to the amount of rows each time.
What you can do is construct the range using Range.End().
ActiveSheet.ListObjects.Add(xlSrcRange, _
Range("$A$1:$H$" & Range("H1").End(xlDown).Row), , xlYes).Name = "MyNewTable2"
Related
Here is my problem, every bit of code, every alteration, every type, doesn't work. I'm using Office 360 at my work site (up to date), so it's excel 2016 and VBA 7.1.
What I'm looking to do is automate our end of shift reports. Here's the process:
We enter data into an excel sheet (Log) every hour. At the end of the day, at 5:00 AM, we save and close that log, open another excel sheet that IMPORTS the data into power pivot, and displays it on a PivotTable (formatting for printing for our bosses), and we choose the filter for the previous date using the filter drop down, and print it. We do this with three (3) reports: 2 PivotTables, and 1 PivotChart. Power Pivot imports ALL of the data from the Log sheet to reformat it for printing.
I've successfully managed to get and rewrite the code (beginner at this) for the automation process of: auto saving the log, closing the log, opening the Report workbook, refreshing the data, and printing the data, then closing the report. The only part I'm now missing is the auto-filtering.
The code I've tried is vast, but here's an example of what I've tried recently (I've erased and re-copied so many codes...)
Sub Filter_PivotField()
'Description: Filter a pivot table or slicer for a specific date or period
'Source: excelcampus.com/vba/filter-pivot-table-slicer-recent-date-period
Dim sSheetName As String
Dim sPivotName As String
Dim sFieldName As String
Dim sFilterCrit As String
Dim pi As PivotFields
'Set the variables
sSheetName = "EOS Report"
sPivotName = "PivotTable1"
sFieldName = "Date"
sFilterCrit = "xlDateYesterday"
'sFilterCrit = ThisWorkbook.Worksheets("EOS Report").Range("O1").Value
With ThisWorkbook.Worksheets(sSheetName).PivotTables(sPivotName).PivotFields(sFieldName)
'Clear all filter of the pivotfield
.ClearAllFilters
'Loop through pivot items of the pivot field
'Hide or filter out items that do not match the criteria
For Each pi In .PivotFields
If pi.Name <> sFilterCrit Then
pi.Visible = False
End If
Next pi
End With
End Sub
To no avail....
When I record a macro doing the manual filter, I get this:
Sub manualfilter()
'
' manualfilter Macro
'
'
ActiveSheet.PivotTables("PivotTable1").PivotFields( _
"[Bi-Hourly Report].[Date].[Date]").VisibleItemsList = Array( _
"[Bi-Hourly Report].[Date].&[2016-09-28T00:00:00]")
End Sub
But it fails when I try to re-run the same macro that I just recorded (after changing the date back). I've enabled and disabled multiple selection option, etc.
Not to mention, trying to auto-filter a chart is a nightmare because tables, yea there's tons of articles on it, but charts? not much comes up on researching.
Here's images of the filter button, because almost everything I've researched is to sort the COLUMN of the Table, not the filter itself with a PivotTable.
Table Filter
Chart Filter
I cannot post the actual excel spreadsheets as they are proprietary property of the company, but I can replicate the format with false data if needed.
check this out.
Dim prev_date As String
prev_date = Month(Date - 1) & "/" & Day(Date - 1) & "/" & Year(Date - 1)
Thisworkbook.Sheets("Sheet1").Activate
'change this line with your sheet where pivot table is present. Change Sheet name.
ActiveSheet.PivotTables("PivotTable1").RefreshTable
ActiveSheet.PivotTables("PivotTable1").PivotFields("Date").CurrentPage = prev_date
I have a macro that takes in some user input values to filter and copy the raw data to a sheet visible to the user.
Sheets("RawData").Range("Raw[#All]").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheets("RawData").Range("AH1:AL" & (i + 1)), _
CopyToRange:=Sheets("User").Range("A15"), Unique:=False
A table is generated from this newly copied data.
Sheets("User").Range("A15").CurrentRegion.Select
Set rng = Selection
Set tbl = Sheets("User").ListObjects.Add(xlSrcRange, rng, xlYes)
tbl.Name = "userSelections"
I have a table "Pareto" on another sheet that is looking to match if Events are happening on the same date:
=COUNTIFS(userSelections[MMM-YY], [Event Date])
However, when the macro regenerates "userTable" it recreates the headers and the formulas in "Pareto" lose their reference to "userTable" which causes this #REF error
=COUNTIFS(#REF!,[Event Date])
Turning calculation mode to manual did not work and deleting only the table contents using DataBodyRange.Rows.Delete or DataBodyRange.ClearContents did not work.
Your problem is that you're deleting the table and recreating it every time. When you delete a table, any formulas that referenced that specific table will then have reference errors because that table doesn't exist anymore (even if the new table has the same name).
I would suggest deleting the table data and then inserting the new data into the existing table.
Untested
Sub main()
Dim tbl As ListObject
Dim rng As Range
'set the tbl variable to the existing table
Set tbl = Sheets("User").ListObjects("userSelections")
'delete the data from the existing table
tbl.DataBodyRange.Delete
'add the new data to the existing table
'tbl.Range accesses the range the tbl covers
'tbl.Range.Cells(1,1) references the first row and column (first cell) in the table range
'tbl.Range.Cells(1,1).Offset(1,0) references the second row in the table, where your data will start
Sheets("RawData").Range("Raw[#All]").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheets("RawData").Range("AH2:AL" & (i + 1)), _
CopyToRange:=tbl.Range.Cells(1, 1).Offset(1, 0), Unique:=False
End Sub
This will copy the data to the table. The table will flex itself to encompass all the data, so there's really no need to create a new table each time.
I was unable to find a way to keep the references, but found a workaround by inserting the formula after the table was recreated each time:
Sheets("RawData").Range("Raw[#All]").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheets("RawData").Range("AH1:AL" & (i + 1)), _
CopyToRange:=Sheets("User").Range("A15"), Unique:=False
Sheets("User").Range("A15").CurrentRegion.Select
Set rng = Selection
Set tbl = Sheets("User").ListObjects.Add(xlSrcRange, rng, xlYes)
tbl.Name = "userSelections"
Sheets("Totals").ListObjects("tblTotal").ListColumns("Total Events").DataBodyRange.FormulaR1C1 = _
"=IF([RowNum] = """", """", COUNTIF(userSelections[MMM-YY], [Event Date]))"
I am trying to create pivot table macro. For this, I have input data and I have a recorded macro on it. However, I am getting an error since I want to use it in multiple areas of the code.
Here is some sample data:
I need output like this:
Sub macro5()
'
' macro5 Macro
'
'
Range("A2:C16").Select
Range("C16").Activate
Sheets.Add
ActiveWorkbook.Worksheets("sheet2").PivotTables("PivotTable3").PivotCache. _
CreatePivotTable TableDestination:="Sheet6!R3C1", TableName:="PivotTable5" _
, DefaultVersion:=xlPivotTableVersion12
Sheets("Sheet6").Select
Cells(3, 1).Select
With ActiveSheet.PivotTables("PivotTable5").PivotFields("Item")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable5").PivotFields("Category")
.Orientation = xlColumnField
.Position = 1
End With
ActiveSheet.PivotTables("PivotTable5").AddDataField ActiveSheet.PivotTables( _
"PivotTable5").PivotFields("Price"), "Sum of Price", xlSum
End Sub
I am getting an error at the highlighted part.
Can anyone help me figure out why?
Your code only works if there is already an existing pivot table from the same dataset on Sheet2, called PivotTable3. Pivot tables share a PivotCache, and if one exists, Excel won't create another, but reuse the existing. That is what your macro is trying to do.
I suggest recording a macro with no pivot table in your document. That way the pivot-cache-creating-code will appear in the recorded macro. If you need multiple pivot tables, then you can use the above macro for the next pivot tables, but make sure to point to your first pivot table's cache.
What you must consider when recording a macro to insert pivot tables:
Notice that the macro recorder recorded some fixed names (e.g. sheet names, pivot table names, data input area). Make sure these are correct, and if not, make them dynamic with variables or otherwise.
Here is a sample code for creating a new pivot table:
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"Sheet2!R1C1:R9C3", Version:=xlPivotTableVersion15).CreatePivotTable _
TableDestination:="Sheet3!R3C1", TableName:="PivotTable1", DefaultVersion:=xlPivotTableVersion15
Notice how it is different form yours.
Now about the problematic parts:
SourceData:="Sheet2!R1C1:R9C3"
If you want your source data to be dynamic, change this. E.g. to make it use your current selection, use this:
SourceData:=Selection
Another interesting part:
TableDestination:="Sheet3!R3C1"
If you just use empty string (""), it will always insert the pivot table on a new sheet (which will also be activated immediately):
TableDestination:=""
The name of the pivot table is not a problem, as from Excel 2007 and up, you can have multiple pivot tables with the same name, as long as they are on different sheets. If you want more pivot tables on the same sheet, you will have to mind the TableName property too.
OK, I could go on about this for many pages. I hope this helps! If you have questions, do ask.
I'd like to setup a macro to remove data from a range within a group of data tables that may change dynamically. For instance, the spreadsheet currently contains 16 data tables listed as L2_1, L2_2, L2_3.....L2_16. I'd like the macro to be flexible enough to be able to expand or contract if the number of tables changes in the sheet. I would also like to delete just the range[L2 number] within the table (this is the same range name for all of the tables).
There are also another type of tables that increment in the sheet as well ("L3L2_1, L3L2_2....L3L2_16). I'd like the macro to ignore these tables. Below is what I have started, but I receive a "1004" error at the clear contents line.
Sub Summary_II_Clear_Contents()
' Clears Summary II Tab
Dim tbl As ListObject
i = 1
For Each tbl In Sheets("Summary II").ListObjects
If tbl.Name Like "L2_" & i Then
Sheets("Summary II").Range("L2_&i&[L2 Number]").ClearContents
i = i + 1
End If
Next tbl
End Sub
Thanks for the help!
I think you just need to fix your If statement.
Also, you need to decide what For Loop construct to use.
If you decide to go with the For Each construct:
For Each tbl In Sheets("Summary II").ListObjects
If InStr(tbl.Name, "L2_") = 1 Then
Sheets("Summary II").Range(tbl.Name & "[L2 Number]").ClearContents
End If
Next tbl
Now, you can also use the classic For Next construct:
With Sheets("Summary II")
For i = 1 To .ListObjects.Count
If InStr(.ListObjects(i).Name, "L2_") = 1 Then
.Range(.ListObjects(i).Name & "[L2 Number]").ClearContents
End If
Next tbl
End With
Take note that we incorporated a With Clause just to make it look clean. HTH.
I have a 3000 rows by 50 columns dataset in Excel starting in A1.
I recorded and edited a macro that emulates the following: Ctrl+A, Format as table:
Dim koosrange As Range
Set koosrange = ActiveSheet.UsedRange
koosrange.Select
ActiveSheet.QueryTables("aspectsClean_1").Delete
ActiveSheet.QueryTables("aspectsClean").Delete
ActiveSheet.ListObjects.Add(xlSrcRange, koosrange, , xlNo).Name = _
"Table1"
Range("Table1[#All]").Select
ActiveSheet.ListObjects("Table1").TableStyle = "TableStyleLight1"
ActiveSheet.ListObjects("Table1").ShowTableStyleFirstColumn = True
The entire program consists of 3 parts:
Import data from *.txt
Concatenate item names to only fit in Col A, and move all other data left, to start in Col B
Format all data as table (so that it can be filtered, etc.)
When running the program, the following error occurs on ActiveSheet.ListObjects.Add(xlSrcRange, koosrange, , xlNo).Name = _
"Table1" (line 6 of the previous code excerpt):
Error: A table cannot overlap a range that contains a PivotTable report, query results, protected cells or another table
Further to my comment, if you used the recorder to record Import > From Text File then the method it would be using would be to add a querytable object connected to the text file, then refreshing it.
Depending on some of the circumstances - I am not fully familiar with the different objects at play in this situation - it is necessary to delete, if they were created, both the connection object and the querytable object.
E.g. a recording i did just now churned out:
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;{snipped path}", Destination:=Range("$A$1"))
.Name = "new 2"
'+some other properties churned out removed here for conciseness
.Refresh BackgroundQuery:=False
End With
So, add just before the End With:
If Not ActiveWorkbook.Connections(.Name) Is Nothing Then
ActiveWorkbook.Connections(.Name).Delete
End If
.Delete
End With