Wrox Programmer Forums
Go Back   Wrox Programmer Forums > Microsoft Office > Excel VBA > Excel VBA
|
Excel VBA Discuss using VBA for Excel programming.
Welcome to the p2p.wrox.com Forums.

You are currently viewing the Excel VBA section of the Wrox Programmer to Programmer discussions. This is a community of software programmers and website developers including Wrox book authors and readers. New member registration was closed in 2019. New posts were shut off and the site was archived into this static format as of October 1, 2020. If you require technical support for a Wrox book please contact http://hub.wiley.com
 
Old May 15th, 2008, 02:11 PM
Registered User
 
Join Date: May 2008
Posts: 1
Thanks: 0
Thanked 0 Times in 0 Posts
Default EXCEL 2003 Can't add DATE PIVOTITEM

'Cut and paste this code into the WORKBOOK_OPEN of a blank workbook, save and reopen,
'for a demo of the following problem:
'''''''''''''''''''''''''''''''''''''
'I need a pivot field ("month") whose 12 items span a year,
'regardless of whether each month is represented in the source data.
'To do this I loop through the PIVOTITEMS to add months that are missing,
'and, though not shown here, to hide months outside my year.
'But I can't get EXCEL to recognize that the new items are DATEs.
'They are not subject to number format and sort incorrectly.
'PIVOTITEMS.ADD is documented as taking a string for an argument.
'Does that mean it's not possible?
''''''''''''''''''''''''''''''''''
Dim PT As PivotTable
Dim PC As PivotCache
Dim Sh1 As Worksheet
Dim Sh2 As Worksheet
Dim PFdate As PivotField
Dim MonthItems(0 To 11) As PivotItem
Dim I As Long
Dim FromDate As Date
Dim ToDate As Date
Dim NewDate As Date
Dim PI As PivotItem
''''''''''''''''''''''''
Set Sh1 = ThisWorkbook.Worksheets("Sheet1")
Set Sh2 = ThisWorkbook.Worksheets("Sheet2")
'''''''''''''''''''''''''''''''''''''''''''
'build source data in sheet1, like:
'DATE NUMBER
'1/1/08 1
'3/1/08 1
'...
'11/1/08 1
'''''''''''''
Sh1.Cells.Clear
NewDate = "1/1/08"
Sh1.Cells(1, 1) = "DATE"
Sh1.Cells(1, 2) = "NUMBER"
For I = 2 To 7
   Sh1.Cells(I, 1) = NewDate
   Sh1.Cells(I, 2) = 1
   NewDate = DateAdd("m", 2, NewDate)
   Next I
Sh1.Cells.HorizontalAlignment = xlHAlignCenter
Sh1.Activate
MsgBox "This is the pivot source."
'''''''''''''''''''''''''''''''''''

Sh1.Cells(1, 1).Select
Sh2.Cells.Clear
Set PC = ThisWorkbook.PivotCaches.Add(xlDatabase, ActiveCell.CurrentRegion)
Set PT = PC.CreatePivotTable(Sh2.Cells(1, 1), "myPivot")
PT.AddFields ColumnFields:="date"
PT.AddDataField PT.PivotFields("number"), "Totals", xlSum
Set PFdate = PT.PivotFields("date")
PFdate.NumberFormat = "mmm-yy"
Sh2.Activate
MsgBox "This is pivot table before adding pivot items."
'''''''''''''''''''''''''''''''''''''''''''''''''' '''''

'define domain:
'''''''''''''''
FromDate = "2008-01-01"
ToDate = DateAdd("m", 11, FromDate)

'fill in PI array with corresponding date items from source:
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''
For Each PI In PFdate.PivotItems
   If PI >= FromDate And PI <= ToDate Then
      Set MonthItems(DateDiff("m", FromDate, PI)) = PI
      End If
   Next PI

'add missing months to PI collection:
'''''''''''''''''''''''''''''''''''''
For I = 0 To 11
   If MonthItems(I) Is Nothing Then
      NewDate = DateAdd("m", I, FromDate)
      PFdate.PivotItems.Add NewDate
      End If
   Next I

PFdate.AutoSort xlAscending, PFdate.SourceName
PFdate.ShowAllItems = True

MsgBox "This is pivot after adding pivot items:" _
      & vbCr & "The lost formatting and sorting suggest that the additions" _
      & vbCr & "are treated as character strings, not dates."







Similar Threads
Thread Thread Starter Forum Replies Last Post
COM add-in for Outlook 2003 written in VSTO '05 SE Arsi BOOK: Professional Outlook 2007 Programming ISBN: 978-0-470-04994-5 6 December 13th, 2007 07:26 PM
Add Javascript code in infopath 2003 ctn101 .NET Framework 2.0 0 March 6th, 2007 12:15 PM
Date(Fabruary-14-2003)??????? heerajee Beginning PHP 0 March 2nd, 2006 07:07 AM
Date problem in Access 2003 dkyr VB Databases Basics 2 December 28th, 2005 07:38 PM





Powered by vBulletin®
Copyright ©2000 - 2020, Jelsoft Enterprises Ltd.
Copyright (c) 2020 John Wiley & Sons, Inc.