Go Back   Access World Forums > Apps and Windows > Excel

 
Reply
 
Thread Tools Rate Thread Display Modes
Old 10-28-2016, 12:30 PM   #1
Rx_
Nothing In Moderation
 
Rx_'s Avatar
 
Join Date: Oct 2009
Location: Denver, Colorado
Posts: 2,770
Thanks: 624
Thanked 332 Times in 304 Posts
Rx_ has a spectacular aura about Rx_ has a spectacular aura about Rx_ has a spectacular aura about
Question Using MSAccess to remotely Pivot Filter and copy results to another tab (Automation)

Any additional ideas on setting filters in an Excel Pivot Table?

Also: Found TableRange2.Address - are there any other features for what seems to be an undocumented Excel object?

The vba running from MSAccess to automate Excel objects:
The ActiveSheet.PivotTables("myPivotTable").PivotField s("Foo").currentpage = "2014"
Just would not work. A few web site post indicated it was troublesome.

After some searching, the following code did work.
ObjXL is an object set to the Excel.Application
This code segment is successfully run from MSAccess (with a reference set to Excel in Tool Options code module).

Pay close attention to the
PivotRange = .ActiveSheet.PivotTables("PivotTable2").TableRange 2.Address

Found TableRange2.Address selects the visible rows in a Pivot and returns the range. It did not show up in the F2 Object browser... but works.

Code:
 '************************************************
' Populate Inv Iss Template tab (not really an Excel template, just the name of a tab)
'objxl.ActiveSheet.PivotTables("PivotTable2").tablerange2.Address
' Tablerange2 is not listed in Object browser - but returns visible rows after filter
' Set pf = ActiveSheet.PivotTables("PivotTable2").PivotFields("Fiscal_Year")
'Clear Out Any Previous Filtering
 ' pf.ClearAllFilters
'************************************************
    Dim RowCount As Long
    Dim PivotRange As String
    Dim FirstCopyRecordCount As Long    ' The count of first Past records with Projects
    Dim SecondCopyRecordCount As Long  ' The count of NoProj
    Dim ThirdCopyRecoordCount As Long   'count of the special situations
    
   ' ****************************************
   ' first level Iss Pivot copy Pasted Projects assigned
   ' ****************************************
    .Sheets("Inv Iss Pivot").Select
    With .ActiveSheet.PivotTables("PivotTable2").PivotFields("Project Number")
        .PivotItems("NO PROJ").Visible = False
        .PivotItems("(blank)").Visible = False
    End With
    PivotRange = .ActiveSheet.PivotTables("PivotTable2").TableRange2.Address
    ' Can't be blank because it includes the last Totals row
    .Range(PivotRange).Select ' NEED to find Last record here see tablerange2
    RowCount = .Selection.Rows.Count
    ' if total is all (count =2 header and total rows) then there is nothing to paste into next worksheet
    If RowCount < 3 Then
        ' exit criteria here - there is nothing to copy
        FirstCopyRecordCount = 0 ' there won't be records, so next copy paste uses this location
    Else
    FirstCopyRecordCount = RowCount ' keep this for 2nd location to paste
    .Range("A4:E" & (RowCount + 1)).Select ' start at row 4 subtract header/Total
    .Application.CutCopyMode = False
    .Selection.Copy
    .Sheets("Inv Iss Template").Select
    .Range("C2").Select
    .Selection.PasteSpecial Paste:=xlPasteFormulasAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    End If
   ' ****************************************
   ' Second level Iss Pivot copy Pasted NO Proj
   ' ****************************************
    .Sheets("Inv Iss Pivot").Select
    .ActiveSheet.PivotTables("PivotTable2").PivotFields("Project Number").ClearAllFilters
    .ActiveSheet.PivotTables("PivotTable2").PivotFields("Project Number").PivotFilters.Add Type:=xlCaptionEquals, Value1:="No PROJ"
    
    'With .ActiveSheet.PivotTables("PivotTable2").PivotFields("Project Number")
        '.PivotItems("NO PROJ").Visible = True
        '.PivotItems("(blank)").Visible = False
    'End With
    PivotRange = .ActiveSheet.PivotTables("PivotTable2").TableRange2.Address
    ' Can't be blank because it includes the last Totals row
    .Range(PivotRange).Select ' NEED to find Last record here see tablerange2
    RowCount = .Selection.Rows.Count
    'Debug.Print "2nd Pivot No Proj"
    ' if total is all (count =2 header and total rows) then there is nothing to paste into next worksheet
    If RowCount < 3 Then
        ' exit criteria here - there is nothing to copy
        SecondCopyRecordCount = 0 ' there won't be records, so next copy paste uses this location
    Else
        SecondCopyRecordCount = RowCount ' keep this for 2nd location to paste
        .Range("A4:E" & (RowCount + 1)).Select ' start at row 4 subtract header/Total
        .Application.CutCopyMode = False
        .Selection.Copy
        .ActiveSheet.PivotTables("PivotTable2").PivotFields("Project Number").ClearAllFilters ' **** Clear all Pivot filters
        .Sheets("Inv Iss Template").Select
        .Range("C" & FirstCopyRecordCount + 3).Select
        '.Range("C2").Select ' first range count
        .Selection.PasteSpecial Paste:=xlPasteFormulasAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        ' This seemed to work!
     End If

__________________
Were you lucky enough to get an answer? Please mark your question as [SOLVED] The original poster can go to Thread Tools to mark it as Solved.

Quotation Thomas Jefferson: "Peace is that brief glorious moment in history when everybody stands around reloading."

There are 2 Kinds of Countries on this Planet
1. Those that use the Metric System
2. Those that had a man walk on the moon

Denver, Colorado - The "Mile High City" - non-metric!
Rx_ is offline   Reply With Quote
Reply

Tags
excel , msaccess , pivot , remoet automation , vba

Thread Tools
Display Modes Rate This Thread
Rate This Thread:

Forum Jump

Similar Threads
Thread Thread Starter Forum Replies Last Post
[SOLVED] Creating Excel Pivot from VBA running in MSAccess, SourceData size limit undocumented Rx_ Excel 1 10-28-2016 06:19 AM
Question Sync Pivot chart/Pivot table Filter msadiqrajani General 0 10-19-2012 05:26 AM
Pivot Chart - data fields automation Roy riggsjø Modules & VBA 0 10-13-2010 10:31 PM
Pivot Table automation question Coldsteel Excel 1 08-21-2009 10:16 PM
access pivot fields via automation gebuh Excel 0 08-18-2006 06:32 AM




All times are GMT -8. The time now is 03:18 PM.


Microsoft Access Help
General
Tables
Queries
Forms
Reports
Macros
Modules & VBA
Theory & Practice
Access FAQs
Code Repository
Sample Databases
Video Tutorials

Sponsored Links

How to advertise

Media Kit


Powered by vBulletin®
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.
(c) copyright 2017 Access World