VBA Code for a pivot table to open database and to reference table current page

  • Thread starter Pete Straman Straman via OfficeKB.com
  • Start date
P

Pete Straman Straman via OfficeKB.com

My code is listed below I have noted the areas where I need help correcting
it. I have to process all databases the same way. It works for the most
part but I am sure it could be improved

Sub Create_Pivot_Table()

' Create_Pivot_Table Macro
' Macro recorded 2/19/2005 by Pete Straman
'
' Keyboard Shortcut: Ctrl+Shift+T
'
Dim SelectedFile As Variant

SelectedFile = Open_File

**** Help here - the code below call the Open File Dialog box
**** I click on the file, it does not open it takes me to the Create ****
Pivot dialog box to open a database then runs through the
**** rest of the code. I think it could be shorter or a different
**** method used. The mdb's are all located in directories which is why
**** I open the dialog box.
With ActiveWorkbook.PivotCaches.Add(SourceType:=xlExternal)
.Connection = Array(Array("ODBC;DSN=MS Access Database;Open_File"),
Array( _
"db;DefaultDir=C:\Documents and Settings\US10555\Desktop\Health
South\Diagnostics\2004 Process;DriverId=25;FIL=MS Access;MaxBuff" _
), Array("erSize=2048;PageTimeout=5;"))
.CommandType = xlCmdSql
.CommandText = Array( _
"SELECT trend_rpt.facilityid, trend_rpt.`Sum of Revenue`,
trend_rpt.`Sum of Payments`, trend_rpt.`Sum of Adjustments`,
trend_rpt.transmoyr, trend_rpt.dosmoyr" & Chr(13) & "" & Chr(10) & "FROM
trend_rpt trend_rpt" _
)
.CreatePivotTable TableDestination:="Sheet1!R1C1", TableName:= _
"PivotTable1", DefaultVersion:=xlPivotTableVersion10
End With
ActiveSheet.PivotTables("PivotTable1").ColumnGrand = False
ActiveSheet.PivotTables("PivotTable1").AddFields RowFields:="dosmoyr", _
PageFields:="facilityid"
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Sum of
Revenue")
.Orientation = xlDataField
.Caption = "Revenue"
.NumberFormat = "$#,##0.00_);($#,##0.00)"
End With
Range("A5:A65").Select

Selection.Sort Order1:=xlAscending, Type:=xlSortLabels, OrderCustom:=7,
_
Orientation:=xlTopToBottom
Columns("A:B").Select
Selection.Copy
Range("C1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.PivotTableWizard TableDestination:="Sheet1!R1C3"
ActiveSheet.PivotTables("PivotTable2").AddFields RowFields:="dosmoyr", _
ColumnFields:="transmoyr", PageFields:="facilityid"
ActiveSheet.PivotTables("PivotTable2").PivotFields("Revenue")
..Orientation = _
xlHidden
With ActiveSheet.PivotTables("PivotTable2").PivotFields("Sum of
Payments")
.Orientation = xlDataField
.Caption = "Payments"
.NumberFormat = "$#,##0.00_);($#,##0.00)"
End With
ActiveSheet.PivotTables("PivotTable2").DataPivotField.PivotItems
("Payments"). _
Position = 1
Columns("C:C").Select
Selection.EntireColumn.Hidden = True
***** I need to reference a facilityid that is created from the mdb *****
Pivot Table. This is from the first macro I recorded it causes a
***** run time error when I run it on other databases because it does
***** not exist when I create the table and should not exist. I need to
***** set a position

'ActiveSheet.PivotTables("PivotTable1").PivotFields("facilityid")
..CurrentPage = _
'"60172"
'ActiveSheet.PivotTables("PivotTable2").PivotFields("facilityid")
..CurrentPage = _
'"60172"

Sheets("Sheet1").Select
Sheets("Sheet1").Name = "Pivot Table"
Sheets("Pivot Table").Select
Sheets("Pivot Table").Copy Before:=Sheets(1)
Sheets("Pivot Table (2)").Select
Sheets("Pivot Table (2)").Name = "Collections"
Cells.Select
Selection.Copy
Cells.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Sheets("Collections").Select
Application.CutCopyMode = False
Sheets("Collections").Move Before:=Sheets(3)
Sheets("Pivot Table").Select

End Sub

Function Open_File() As Variant
'
' Open File Macro
' Macro recorded 2/20/2005 by Pete Straman
'
'Declare a variable as a FileDialog object.
Dim fd As FileDialog

'Create a FileDialog object as a File Picker dialog box.
Set fd = Application.FileDialog(msoFileDialogFilePicker)

'Declare a variable to contain the path
'The path is a String but a variable is used to accommodate
'the use with For Each...Next routines which only work with Variants
and Objects.
Dim vrtSelectedItem As Variant

'Use a With...End With block to reference the FileDialog object.
With fd

'Use the Show method to display the File Picker dialog box and
return the user's action.
'The user pressed the action button.
If .Show = -1 Then

'vrtSelectedItem is a String that contains the path of each
selected item.
Open_File = vrtSelectedItem

'The user pressed Cancel instead of opening a file
Else

End If
End With

'Set the object variable to Nothing.
Set fd = Nothing

End Function

thanks in advance for any help.

C. Pete Straman
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top