I recorded a macro that makes some pivot tables in a new sheet and it works fine, so i tried to make it able to overwrite if the sheet already existed but i can't seem to make it work. The problem is that when i use the macro once it does add the new sheet but it also adds another one on top of the one already made, and when i try to use the macro again to see if it overwrites the other one, it doesn't it just adds another unnamed sheet.
The code looks like this:
Sub Makro7()
Sheets.Add After:=ActiveSheet
On Error Resume Next
Sheets.Add().Name = "Statistics"
On Error GoTo 0
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"Base!R1C1:R18288C12", Version:=6).CreatePivotTable TableDestination:= _
"Statistics!R1C1", TableName:="Pivottabel22", DefaultVersion:=6
Sheets("Statistics").Select
Cells(1, 1).Select
ActiveSheet.PivotTables("Pivottabel22").AddDataField ActiveSheet.PivotTables( _
"Pivottabel22").PivotFields("FACULTY_ID"), "Antal af FACULTY_ID", xlCount
With ActiveSheet.PivotTables("Pivottabel22").PivotFields("FACULTY_ID")
.Orientation = xlColumnField
.Position = 1
End With
With ActiveSheet.PivotTables("Pivottabel22").PivotFields("PROGRAM_TYPE_NAME")
.Orientation = xlRowField
.Position = 1
End With
Range("A1").Select
ActiveSheet.PivotTables("Pivottabel22").DataPivotField.PivotItems( _
"Antal af FACULTY_ID").Caption = "Antal"
Range("B1").Select
ActiveSheet.PivotTables("Pivottabel22").CompactLayoutColumnHeader = "Fakultet"
Range("A7").Select
ActiveWorkbook.Worksheets("Statistics").PivotTables("Pivottabel22").PivotCache. _
CreatePivotTable TableDestination:="Statistics!R7C1", TableName:= _
"Pivottabel23", DefaultVersion:=6
Sheets("Statistics").Select
Cells(7, 1).Select
ActiveSheet.PivotTables("Pivottabel23").AddDataField ActiveSheet.PivotTables( _
"Pivottabel23").PivotFields("FACULTY_ID"), "Antal af FACULTY_ID", xlCount
With ActiveSheet.PivotTables("Pivottabel23").PivotFields("PROGRAM_TYPE_NAME")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("Pivottabel23").PivotFields("FACULTY_ID")
.Orientation = xlColumnField
.Position = 1
End With
With ActiveSheet.PivotTables("Pivottabel23").PivotFields("Antal af FACULTY_ID")
.Calculation = xlPercentOfTotal
.NumberFormat = "0.00%"
End With
Range("A7").Select
ActiveSheet.PivotTables("Pivottabel23").DataPivotField.PivotItems( _
"Antal af FACULTY_ID").Caption = "Procentvis"
Range("B7").Select
ActiveSheet.PivotTables("Pivottabel23").CompactLayoutColumnHeader = "Fakultet"
Range("A13").Select
ActiveWorkbook.Worksheets("Statistics").PivotTables("Pivottabel23").PivotCache. _
CreatePivotTable TableDestination:="Statistics!R13C1", TableName:= _
"Pivottabel24", DefaultVersion:=6
Sheets("Statistics").Select
Cells(13, 1).Select
ActiveSheet.PivotTables("Pivottabel24").AddDataField ActiveSheet.PivotTables( _
"Pivottabel24").PivotFields("ENROLL_LOCATION_NAME"), _
"Antal af ENROLL_LOCATION_NAME", xlCount
With ActiveSheet.PivotTables("Pivottabel24").PivotFields("ENROLL_LOCATION_NAME" _
)
.Orientation = xlRowField
.Position = 1
End With
Range("B13").Select
ActiveSheet.PivotTables("Pivottabel24").DataPivotField.PivotItems( _
"Antal af ENROLL_LOCATION_NAME").Caption = "Antal"
Range("A13").Select
ActiveSheet.PivotTables("Pivottabel24").CompactLayoutRowHeader = "Campus"
Range("B13").Select
ActiveSheet.PivotTables("Pivottabel24").DataPivotField.PivotItems("Antal"). _
Caption = "Antal af studerende"
Range("A22").Select
ActiveWorkbook.Worksheets("Statistics").PivotTables("Pivottabel24").PivotCache. _
CreatePivotTable TableDestination:="Statistics!R22C1", TableName:= _
"Pivottabel25", DefaultVersion:=6
Sheets("Statistics").Select
Cells(22, 1).Select
ActiveSheet.PivotTables("Pivottabel25").AddDataField ActiveSheet.PivotTables( _
"Pivottabel25").PivotFields("ENROLL_LOCATION_NAME"), _
"Antal af ENROLL_LOCATION_NAME", xlCount
With ActiveSheet.PivotTables("Pivottabel25").PivotFields("ENROLL_LOCATION_NAME" _
)
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("Pivottabel25").PivotFields( _
"Antal af ENROLL_LOCATION_NAME")
.Calculation = xlPercentOfTotal
.NumberFormat = "0.00%"
End With
Range("A22").Select
ActiveSheet.PivotTables("Pivottabel25").CompactLayoutRowHeader = "Campus"
Range("B22").Select
ActiveSheet.PivotTables("Pivottabel25").DataPivotField.PivotItems( _
"Antal af ENROLL_LOCATION_NAME").Caption = "Procentvis af studerende"
Range("I1").Select
ActiveWorkbook.Worksheets("Statistics").PivotTables("Pivottabel25").PivotCache. _
CreatePivotTable TableDestination:="Statistics!R1C9", TableName:= _
"Pivottabel26", DefaultVersion:=6
Sheets("Statistics").Select
Cells(1, 9).Select
ActiveSheet.PivotTables("Pivottabel26").AddDataField ActiveSheet.PivotTables( _
"Pivottabel26").PivotFields("STUDYBOARD_ID"), "Antal af STUDYBOARD_ID", xlCount
With ActiveSheet.PivotTables("Pivottabel26").PivotFields("STUDYBOARD_ID")
.Orientation = xlRowField
.Position = 1
End With
Range("I1").Select
ActiveSheet.PivotTables("Pivottabel26").CompactLayoutRowHeader = "Studienævn"
Range("J1").Select
ActiveSheet.PivotTables("Pivottabel26").DataPivotField.PivotItems( _
"Antal af STUDYBOARD_ID").Caption = "Antal af studerende"
Range("L15").Select
End Sub
The problem is this piece of code:
Sheets.Add After:=ActiveSheet
On Error Resume Next
Sheets.Add().Name = "Statistics"
On Error GoTo 0
This basically tells Excel to add a new sheet after the active sheet and when you run the macro the second time, the sheetname "Statistics" is already taken. (And if it wasn't for On error resume next, an error message would appear the second time). Add this at the top of your macro instead:
Dim newSheet As Worksheet
Application.DisplayAlerts = False
Set newSheet = Sheets.Add(After:=ActiveSheet)
With newSheet
On Error Resume Next
ThisWorkbook.Sheets("Statistics").Delete
On Error GoTo 0
.name = "Statistics"
End With
Application.DisplayAlerts = True
Related
I have this macro that takes all of sheet1 and creates a pivot table of it. However, it is currently only looking at the amount of rows I had when I made it and not the entire sheet no matter how many rows it has that day. Is there any way to make it select all of sheet1 as the pivot table data every time?
If possible I would also like to alter the fix duplicates to be the entire column based on the column name (IDNUMBER) if able.
Range("$A$1:$AM$2428")
Range("$A$1:$AM$4000")
"PIVOT_STATE_REPORT!R1C1:R1048576C39"
Sub PIVOT_STATE()
'
' PIVOT_STATE Macro
'
'
'ActiveSheet.Range("$A$1:$AM$2428").RemoveDuplicates Columns:=36, Header:= _
'xlYes
Columns("AJ:AJ").Select
ActiveSheet.Range("$A$1:$AM$4000").RemoveDuplicates Columns:=36, Header:= _
xlYes
Range("A2").Select
Sheets.Add
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"PIVOT_STATE_REPORT!R1C1:R1048576C39", Version:=xlPivotTableVersion15). _
CreatePivotTable TableDestination:="Sheet1!R3C1", TableName:="PivotTable1" _
, DefaultVersion:=xlPivotTableVersion15
Sheets("Sheet1").Select
Cells(3, 1).Select
With ActiveSheet.PivotTables("PivotTable1").PivotFields("State (Corrected)")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
"PivotTable1").PivotFields("Count"), "Sum of Count", xlSum
ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
"PivotTable1").PivotFields("Claim Age in CS"), _
"Sum of Claim Age in CS", xlSum
ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
"PivotTable1").PivotFields("Days Since LHN"), _
"Sum of Days Since LHN", xlSum
Range("B3").Select
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Sum of Count")
.Caption = "Count of Count"
.Function = xlCount
End With
Range("C3").Select
With ActiveSheet.PivotTables("PivotTable1").PivotFields( _
"Sum of Claim Age in CS")
.Caption = "Average of Claim Age in CS"
.Function = xlAverage
.NumberFormat = "0"
End With
Range("D3").Select
With ActiveSheet.PivotTables("PivotTable1").PivotFields( _
"Sum of Days Since LHN")
.Caption = "Average of Days Since LHN"
.Function = xlAverage
.NumberFormat = "0"
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("State (Corrected)")
End With
End Sub
Thanks in advance!
I would use the last row and column formulas provided in this function.
Then make the source a combo of these variables.
Function LastRowColumn(sht As Worksheet, RowColumn As String) As Long
'PURPOSE: Function To Return the Last Row Or Column Number In the Active
Spreadsheet
'INPUT: "R" or "C" to determine which direction to search
Dim rc As Long
Select Case LCase(Left(RowColumn, 1)) 'If they put in 'row' or column instead of 'r' or 'c'.
Case "c"
LastRowColumn = sht.Cells.Find("*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
Case "r"
LastRowColumn = sht.Cells.Find("*", LookIn:=xlFormulas, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
Case Else
LastRowColumn = 1
End Select
End Function
Then inside of your macro call out:
x = LastRowColumn(ActiveSheet, "column")
y = LastRowColumn(ActiveSheet, "Row")
plast = cells(x,y)
Then make a range based off that for the source of the pivot table
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"PIVOT_STATE_REPORT!A1:" & plast, Version:=xlPivotTableVersion15). _
CreatePivotTable TableDestination:="Sheet1!R3C1", TableName:="PivotTable1" _
, DefaultVersion:=xlPivotTableVersion15
I think the easiest way of doing this will be to replace these lines of your code
Columns("AJ:AJ").Select
ActiveSheet.Range("$A$1:$AM$4000").RemoveDuplicates Columns:=36, Header:=xlYes
Range("A2").Select
With
Dim rData As Range: Set rData = ActiveSheet.Range("A1", ActiveSheet.Range("A1").End(xlDown))
Set rData = Range(rData, rData.End(xlToRight))
rData.RemoveDuplicates Columns:=36, Header:=xlYes
ActiveWorkbook.PivotCaches.Create SourceType:=xlDatabase, SourceData:=rData
The update this be where you make your PivotCache
`
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"PIVOT_STATE_REPORT!R1C1:R1048576C39", Version:=xlPivotTableVersion15). _
CreatePivotTable TableDestination:="Sheet1!R3C1", TableName:="PivotTable1" _
, DefaultVersion:=xlPivotTableVersion15c
`
With the following code using the rData range as the Source Data
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
rData, Version:=xlPivotTableVersion15). _
CreatePivotTable TableDestination:="Sheet1!R3C1", TableName:="PivotTable1" _
, DefaultVersion:=xlPivotTableVersion15
Note this assumes that there are no gaps in the columns or rows of your Data. The End(xlDown) is the equivalent of holding the Ctrl and Down key
If possible I would like the macro below to run the same way, regardless of what the name of the sheet is. For instance on this file it's "ZPPV Final for March 2015". But that March, may change to April or May, etc. Can I have this macro run regardless of what month is on that sheets tab? Please see below:
Sub PPV()
'
' PPV Macro
'
'
Sheets("ZPPV Final for March 2015").Select
Range("Z3").Select
ActiveCell.FormulaR1C1 = "Week"
Range("Z4").Select
ActiveCell.FormulaR1C1 = "=WEEKNUM(RC[-9])"
Range("Z4").Select
Selection.AutoFill Destination:=Range("Z4:Z8858")
Range("Z4:Z8858").Select
Range("Z3").Select
Range(Selection, Selection.End(xlToLeft)).Select
Range(Selection, Selection.End(xlDown)).Select
Sheets.Add
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"***ZPPV Final for March 2015***!R3C2:R8858C26", Version:=xlPivotTableVersion14). _
CreatePivotTable TableDestination:="Sheet2!R3C1", TableName:="PivotTable9" _
, DefaultVersion:=xlPivotTableVersion14
Sheets("Sheet2").Select
Cells(3, 1).Select
With ActiveSheet.PivotTables("PivotTable9").PivotFields("Plant")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable9").PivotFields("Week")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("PivotTable9").AddDataField ActiveSheet.PivotTables( _
"PivotTable9").PivotFields(" PPV"), "Sum of PPV", xlSum
ActiveSheet.PivotTables("PivotTable9").PivotFields("Plant").ClearAllFilters
ActiveSheet.PivotTables("PivotTable9").PivotFields("Plant").CurrentPage = _
"1027"
Sheets("**ZPPV Final for March 2015").**Select
ActiveWorkbook.Worksheets("Sheet2").PivotTables("PivotTable9").PivotCache. _
CreatePivotTable TableDestination:="Sheet2!R1C6", TableName:="PivotTable10" _
, DefaultVersion:=xlPivotTableVersion14
Sheets("Sheet2").Select
Cells(1, 6).Select
With ActiveSheet.PivotTables("PivotTable10").PivotFields("Plant")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable10").PivotFields("Week")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("PivotTable10").AddDataField ActiveSheet.PivotTables( _
"PivotTable10").PivotFields(" PPV"), "Sum of PPV", xlSum
With ActiveSheet.PivotTables("PivotTable10").PivotFields("Vendor Name")
.Orientation = xlRowField
.Position = 1
End With
Range("F4").Select
ActiveSheet.PivotTables("PivotTable10").PivotFields("Vendor Name").ShowDetail _
= False
ActiveSheet.PivotTables("PivotTable10").PivotFields("Plant").ClearAllFilters
ActiveSheet.PivotTables("PivotTable10").PivotFields("Plant").CurrentPage = _
"1027"
Sheets("ZPPV Final for March 2015").Select
ActiveWorkbook.Worksheets("Sheet2").PivotTables("PivotTable10").PivotCache. _
CreatePivotTable TableDestination:="Sheet2!R1C10", TableName:= _
"PivotTable11", DefaultVersion:=xlPivotTableVersion14
Sheets("Sheet2").Select
Cells(1, 10).Select
With ActiveSheet.PivotTables("PivotTable11").PivotFields("Plant")
.Orientation = xlPageField
.Position = 1
End With
ActiveSheet.PivotTables("PivotTable11").AddDataField ActiveSheet.PivotTables( _
"PivotTable11").PivotFields(" PPV"), "Sum of PPV", xlSum
With ActiveSheet.PivotTables("PivotTable11").PivotFields("Material No.")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("PivotTable11").PivotFields("Plant").ClearAllFilters
ActiveSheet.PivotTables("PivotTable11").PivotFields("Plant").CurrentPage = _
"1027"
Range("A3").Select
ActiveSheet.PivotTables("PivotTable9").CompactLayoutRowHeader = "Week"
Range("F3").Select
ActiveSheet.PivotTables("PivotTable10").CompactLayoutRowHeader = "Vendor"
Range("J3").Select
ActiveSheet.PivotTables("PivotTable11").CompactLayoutRowHeader = _
"Material Number"
Range("A2").Select
ActiveCell.FormulaR1C1 = "PPV By Week"
Range("F2").Select
ActiveCell.FormulaR1C1 = "PPV By Vendor"
Range("J2").Select
ActiveCell.FormulaR1C1 = "PPV By Material #"
Range("J2").Select
Selection.Font.Bold = True
Range("F2").Select
Selection.Font.Bold = True
Range("A2").Select
Selection.Font.Bold = True
Range("D3").Select
End Sub
Here's a quick example
Dim sh as worksheet
Dim ws as worksheet
set ws=sheets("Sheet2")
set sh=activesheet
sh.Range("Z3") = "Week"
with ws
'do something
end with
If there is only one worksheet in your workbook, then use the index.
Dim ws As Worksheet ' Declare a worksheet type variable
Set ws = Thisworksbook.Sheets(1) ' assign the worksheet object
If there are other worksheets but the same worksheet is used all throughout (meaning, the sheet name is just edited for the new month) then use the worksheet codename.
Dim ws As Worksheet ' Declare a worksheet type variable
Set ws = Sheet1 ' use Codename to assign worksheet object to variable
You can only edit the Codename in the properties window as shown above.
The user can change the sheet name outside but not the Codename.
If a new sheet is created for every month, use a loop.
Dim ws As Worksheet, i As Integer
Dim MoYr As String
MoYr = Format(Date, "mmmm yyyy") ' Returns April 2015 if run now
With ThisWorkbook
For i = 1 To .Sheets.Count
If InStr(.Sheets(i).Name, MoYr) <> 0 Then
Set ws = .Sheets(i): Exit For
End If
Next
End With
If ws Is Nothing Then Exit Sub ' Just in case nothing is found
All,
I call this subfunction within a loop in another subfunction. The loop works well without this sub called. When I call this sub, it works fine once, and then, on the second go, I get a "runtime error 5 - invalid procedure call or argument" here.
I have many sheets, each with a table. I want to summarize each table with a pivot table.
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
tblnm, Version:=xlPivotTableVersion10).CreatePivotTable _
TableDestination:=dest, TableName:=pivnm, _
DefaultVersion:=xlPivotTableVersion10
You can see the whole subfunction below.
Sub PIVOT()
Dim pivnm, shtnm, tblnm, dest As String
Application.EnableEvents = False
shtnm = ActiveSheet.Name
tblnm = Range("N2").Value 'I have previously sent the table name to this cell
pivnm = tblnm & " PIVOT"
tblnm = Replace(tblnm, " ", "_")
'The tables are named with underscores, but were stored with spaces
Range("N3") = pivnm
With Range("N3") 'simply wraps the text in the cell
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
dest = shtnm & "!R1C15" 'sets the destination
Sheets(shtnm).Select
Range("C1").Select
'the following was written using the macro recorder, with names replaced by
'variables
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
tblnm, Version:=xlPivotTableVersion10).CreatePivotTable _
TableDestination:=dest, TableName:=pivnm, _
DefaultVersion:=xlPivotTableVersion10
Sheets(shtnm).Select
Cells(1, 15).Select
With ActiveSheet.PivotTables(pivnm).PivotFields("Process text")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables(pivnm).AddDataField ActiveSheet.PivotTables( _
pivnm).PivotFields("Process text"), "Count of Process text", xlCount
ActiveSheet.PivotTables(pivnm).AddDataField ActiveSheet.PivotTables( _
pivnm).PivotFields("Column1"), "Sum of Column1", xlSum
With ActiveSheet.PivotTables(pivnm).DataPivotField
.Orientation = xlColumnField
.Position = 1
End With
With ActiveSheet.PivotTables(pivnm).PivotFields("Process text")
.Orientation = xlRowField
.Position = 1
End With
shtnm = vbNullString 'I tried resetting everything. Didn't work
tblnm = vbNullString
pivnm = vbNullString
dest = vbNullString
End Sub
Please let me know if I have left any information out or if there is anything I can do better!
I was asked to attach the loop from the other function - so here it is...It probably looks ridiculous to anyone but me...
While count3 <= count2
DoEvents
Application.StatusBar = "Updating. Sheet " & (count3) & " of 61 complete."
Sheets("Sheet2").Select
Selection.AutoFilter Field:=2
Selection.AutoFilter Field:=2, Criteria1:=Range("O" & CStr(count3)).Value
Range("A1:M" & CStr(count)).Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.count)
ActiveSheet.Paste
If Range("B2") <> "" Then
ActiveSheet.Name = Range("B2")
tblnm = Range("B2").Value
Sheets(tblnm).Select
Application.StatusBar = "Making Table" & (count3) & " of 61 complete."
While Range("B" & CStr(count4 + 1)) <> ""
count4 = count4 + 1
Wend
Range("N1").Value = count4
DataArea = ("$A$1:$M$" & count4)
DataArea1 = DataArea
ActiveWorkbook.ActiveSheet.ListObjects.Add(xlSrcRange, Range(DataArea1), , xlYes).Name = _
tblnm
ActiveWorkbook.ActiveSheet.ListObjects(tblnm).Range.AutoFilter Field:=5, Criteria1:= _
"=*UF_*", Operator:=xlAnd, Criteria2:="<>*Drive*"
ActiveSheet.ListObjects(tblnm).Range.AutoFilter Field:=8, Criteria1:= _
"<>#VALUE!", Operator:=xlAnd
ActiveWorkbook.Worksheets(tblnm).ListObjects(tblnm).Sort.SortFields.Add Key _
:=Range("M1:M" & CStr(count4)), SortOn:=xlSortOnValues, Order:=xlDescending, _
DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets(tblnm).ListObjects(tblnm).Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Call RhidRow
Columns("A:A").EntireColumn.Hidden = True
Columns("B:B").EntireColumn.Hidden = True
Columns("F:F").EntireColumn.Hidden = True
Columns("G:G").EntireColumn.Hidden = True
Columns("H:H").EntireColumn.Hidden = True
Columns("I:I").EntireColumn.Hidden = True
Columns("J:J").EntireColumn.Hidden = True
Columns("K:K").EntireColumn.Hidden = True
Columns("L:L").EntireColumn.Hidden = True
Columns("C:C").EntireColumn.AutoFit
Columns("D:D").EntireColumn.AutoFit
Columns("E:E").EntireColumn.AutoFit
Columns("M:M").EntireColumn.AutoFit
While Range("M" & CStr(count5 + 1)) <> ""
count5 = count5 + 1
Wend
Range("N2") = tblnm
With Range("N2")
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Call PIVOT
Else
ActiveSheet.Delete
End If
Range("A1").Select
count3 = count3 + 1
count4 = 2
count6 = 2
Wend
If your sheet names have spaces in them, you need:
dest = "'" & shtnm & "'!R1C15"
This is untested, but as an idea as to passing parameters:
Sub PIVOT(tblnm As String, ws As Worksheet)
Dim pivnm As String
Dim shtnm As String
Dim dest As String
Dim PT As PivotTable
Application.EnableEvents = False
With ws
shtnm = "'" & .Name & "'"
pivnm = tblnm & " PIVOT"
tblnm = Replace(tblnm, " ", "_")
'The tables are named with underscores, but were stored with spaces
With .Range("N3")
.Value = pivnm
'simply wraps the text in the cell
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
End With
dest = shtnm & "!R1C15" 'sets the destination
'the following was written using the macro recorder, with names replaced by
'variables
Set PT = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
tblnm, Version:=xlPivotTableVersion10).CreatePivotTable( _
TableDestination:=dest, TableName:=pivnm, _
DefaultVersion:=xlPivotTableVersion10)
With PT
With .PivotFields("Process text")
.Orientation = xlRowField
.Position = 1
End With
.AddDataField .PivotFields("Process text"), "Count of Process text", xlCount
.AddDataField .PivotFields("Column1"), "Sum of Column1", xlSum
With .DataPivotField
.Orientation = xlColumnField
.Position = 1
End With
With .PivotFields("Process text")
.Orientation = xlRowField
.Position = 1
End With
End With
End Sub
and the calling code would use something like:
Call PIVOT(tblnm, wks)
where wks is a Worksheet variable set to whichever sheet has the data.
I have the code below which theoretically should create a pivot table on a 2nd sheet (which exists) using the data it finds on the 'DATA' sheet. However it always crashes as soon as it reaches the part to create the pivot table.
I originally come from a fixed size and afterwards changed it so it should take all the data on my 'DATA' sheet regardless of whether it's a 2x3 or 58x13 table
Sheets("DATA").Select
Range("H1").Select
ActiveCell.FormulaR1C1 = "l"
Range("A1").Select
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
Sheets("DATA").Range("A1").CurrentRegion, _
Version:=xlPivotTableVersion14).CreatePivotTable _
TableDestination:="Prior. per user!R1C1", TableName:="PivotTable1", _
DefaultVersion:=xlPivotTableVersion14
Sheets("Prior. per user").Select
Cells(1, 1).Select
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Priority")
.Orientation = xlColumnField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Caller")
.Orientation = xlRowField
.Position = 1
End With
Range("D2").Select
ActiveSheet.PivotTables("PivotTable1").PivotFields("Priority").PivotItems( _
"Medium").Position = 2
Columns("D:D").ColumnWidth = 7.43
Columns("C:C").ColumnWidth = 10
ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
"PivotTable1").PivotFields("Number"), "Sum of Number", xlSum
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Sum of Number")
.Caption = "Count of Number"
.Function = xlCount
End With
If anyone sees what's wrong with it, it would be much appreciated.
Your target sheet name has spaces in it so you need to enclose it in single quotes:
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
Sheets("DATA").Range("A1").CurrentRegion, _
Version:=xlPivotTableVersion14).CreatePivotTable _
TableDestination:="'Prior. per user'!R1C1", TableName:="PivotTable1", _
DefaultVersion:=xlPivotTableVersion14
Personally, I would also use a variable to refer to the pivot table:
Dim PT As PivotTable
Set PT = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
Sheets("DATA").Range("A1").CurrentRegion, _
Version:=xlPivotTableVersion14).CreatePivotTable(TableDestination:="'Prior. per user'!R1C1", TableName:="PivotTable1", _
DefaultVersion:=xlPivotTableVersion14)
With PT
With .PivotFields("Priority")
.Orientation = xlColumnField
.Position = 1
End With
With .PivotFields("Caller")
.Orientation = xlRowField
.Position = 1
End With
.PivotFields("Priority").PivotItems("Medium").Position = 2
.Parent.Columns("D:D").ColumnWidth = 7.43
.Parent.Columns("C:C").ColumnWidth = 10
.AddDataField .PivotFields("Number"), "Count of Number", xlCount
End With
I am trying to record a macro which will create pivot chart out of excel data and here is the code that has been recorded:
Sub chart1()
'
' chart1 Macro
'
'
Range("E1:F11").Select
Sheets.Add
In Debugger, code within the **** **** is shown in Yellow color
***** ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"data!R1C5:R11C6", Version:=xlPivotTableVersion12).CreatePivotTable _
TableDestination:="Sheet1!R3C1", TableName:="PivotTable1", DefaultVersion _
:=xlPivotTableVersion12 ********
Sheets("Sheet1").Select
Cells(3, 1).Select
With ActiveSheet.PivotTables("PivotTable1").PivotFields("question1")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("answer1")
.Orientation = xlColumnField
.Position = 1
End With
ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
"PivotTable1").PivotFields("answer1"), "Count of answer1", xlCount
With ActiveSheet.PivotTables("PivotTable1").PivotFields("answer1")
.Orientation = xlPageField
.Position = 1
End With
ActiveSheet.PivotTables("PivotTable1").PivotFields("answer1").Orientation = _
xlHidden
With ActiveSheet.PivotTables("PivotTable1").PivotFields("answer1")
.Orientation = xlColumnField
.Position = 1
End With
ActiveSheet.Shapes.AddChart.Select
ActiveChart.SetSourceData Source:=Range("Sheet1!$A$3:$D$6")
ActiveSheet.Shapes.AddChart.Select
ActiveChart.SetSourceData Source:=Range("Sheet1!$A$3:$D$6")
ActiveChart.ChartType = xlColumnClustered
End Sub
Why am I getting the Run Time Error 1004: Application-Defined or Object Defined Error when i try to run this macro ?
Thanks in advance..
Since you want the chart to be on a new sheet,
you have to change the macro's "Sheet1" to new worksheet's name,
The following macro should work for you, I have named the new worksheet as newWs
And fyi, your macro's error message I believe is due to trying to creating 2 pivot table of the same name on "Sheet1" is not allowed.
He also like to know what to create pivotTable base on Selected Area, so I have done modification to the code.
Edited: I Assume you select 2 columns each time
Sub chart1()
'
' chart1 Macro
'
'
Dim selectedSheetName As String
Dim newWs As Worksheet
Dim rangeName As String
Dim header1 As String
Dim header2 As String
header1 = ActiveSheet.Cells(1, Selection.Column).Value
header2 = ActiveSheet.Cells(1, Selection.Column + 1).Value
selectedSheetName = ActiveSheet.Name
rangeName = Selection.Address
Set newWs = Sheets.Add
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
selectedSheetName & "!" & rangeName, Version:=xlPivotTableVersion12).CreatePivotTable _
TableDestination:=newWs.Name & "!R3C1", TableName:="PivotTable1", DefaultVersion _
:=xlPivotTableVersion12
newWs.Activate
Cells(3, 1).Select
With ActiveSheet.PivotTables("PivotTable1").PivotFields(header1)
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields(header2)
.Orientation = xlColumnField
.Position = 1
End With
ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
"PivotTable1").PivotFields(header2), "Count of answer1", xlCount
With ActiveSheet.PivotTables("PivotTable1").PivotFields(header2)
.Orientation = xlPageField
.Position = 1
End With
ActiveSheet.PivotTables("PivotTable1").PivotFields(header2).Orientation = _
xlHidden
With ActiveSheet.PivotTables("PivotTable1").PivotFields(header2)
.Orientation = xlColumnField
.Position = 1
End With
ActiveSheet.Shapes.AddChart.Select
ActiveChart.SetSourceData Source:=Range(newWs.Name & "!$A$3:$D$6")
ActiveSheet.Shapes.AddChart.Select
ActiveChart.SetSourceData Source:=Range(newWs.Name & "!$A$3:$D$6")
ActiveChart.ChartType = xlColumnClustered
End Sub