Date Format VBA code

HikingGiraffe

New Member
Joined
Jul 22, 2021
Messages
8
Office Version
  1. 365
Platform
  1. Windows
I have searched the internet tirelessly for an answer to this question that I desperately need more understanding on.
What I am trying to do is create a macro that will take raw data on one sheet and put it into a pivot table on a new sheet - pretty standard procedure right?

The issue is that I cannot, for the life of me, figure out how to make the dates in column C read in date format instead of default text or general format. On the pivot table, it is asking the user to sort A-Z or Z-A which sorts by the month / numerical order instead of newest to oldest which is what I am looking to do.

I am well aware of all the manual fixes to this, but the intention is for this sheet to be opened, data to be imported, and the table to be ready to analyze.
So with that being said, this is the section of the code I am working with:

Private Sub Workbook_Open()
Dim FileToOpen As Variant
Dim OpenBook As Workbook
FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.xls*),*xls*")
If FileToOpen <> False Then
Set OpenBook = Application.Workbooks.Open(FileToOpen)
OpenBook.Worksheets("Aggregate View").Range("A1:Y300").Copy
ThisWorkbook.Worksheets("AggregateView").Range("A1").PasteSpecial xlPasteValues
OpenBook.Close False
End If
Dim datrange As Range
Set datrange = Range("C9:C500")
datrange.NumberFormat = "MM/dd/yyyy"
'The following line will run Macro2
Call WageSummaryPivotTableVersion1_1
End Sub

I am not getting any error codes, and it is changing the selected cells but it's changing them to a custom format that isnt properly reflecting date format in the pivot table.

Please feel free to massacre my code, I am brand new at VBA and would love to hear any and all suggestions for improvement.

Thank you!
 

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.
I realized there is no "mm/dd/yyyy" format and that was my issue. So I changed the code to "m/d/yyyy" which applied the date format to the page that contains raw data. However, it is not reflecting over to my pivot table... This is the full code of what I have so far:

Private Sub Workbook_Open()
Dim FileToOpen As Variant
Dim OpenBook As Workbook
FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.xls*),*xls*")
If FileToOpen <> False Then
Set OpenBook = Application.Workbooks.Open(FileToOpen)
OpenBook.Worksheets("Aggregate View").Range("A1:Y500").Copy
ThisWorkbook.Worksheets("AggregateView").Range("A1").PasteSpecial xlPasteValues
OpenBook.Close False
End If
Dim datrange As Range
Set datrange = Range("C9:C500")
datrange.NumberFormat = "m/d/yyyy"
'The following line will run Macro2
Call WageSummaryPivotTableVersion1_1
End Sub


Sub WageSummaryPivotTableVersion1_1()
'
' WageSummaryPivotTableVersion1_1 Macro
' Creates Updated Pivot Table for Version 1.1
'
'
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"AggregateView!R8C1:R300C25", Version:=6).CreatePivotTable TableDestination _
:="WageSummary!R4C1", TableName:="PivotTable1", DefaultVersion:=6
Sheets("WageSummary").Select
Cells(4, 1).Select
With ActiveSheet.PivotTables("PivotTable1")
.ColumnGrand = True
.HasAutoFormat = True
.DisplayErrorString = False
.DisplayNullString = True
.EnableDrilldown = True
.ErrorString = ""
.MergeLabels = False
.NullString = ""
.PageFieldOrder = 2
.PageFieldWrapCount = 0
.PreserveFormatting = True
.RowGrand = True
.SaveData = True
.PrintTitles = False
.RepeatItemsOnEachPrintedPage = True
.TotalsAnnotation = False
.CompactRowIndent = 1
.InGridDropZones = False
.DisplayFieldCaptions = True
.DisplayMemberPropertyTooltips = False
.DisplayContextTooltips = True
.ShowDrillIndicators = True
.PrintDrillIndicators = False
.AllowMultipleFilters = False
.SortUsingCustomLists = True
.FieldListSortAscending = False
.ShowValuesRow = False
.CalculatedMembersInFilters = False
.RowAxisLayout xlCompactRow
End With
With ActiveSheet.PivotTables("PivotTable1").PivotCache
.RefreshOnFileOpen = False
.MissingItemsLimit = xlMissingItemsDefault
End With
ActiveSheet.PivotTables("PivotTable1").RepeatAllLabels xlRepeatLabels
With ActiveSheet.PivotTables("PivotTable1").PivotFields("PP END DATE")
.Orientation = xlRowField
.Position = 1
End With

*pivot table field selection code here... removed due to containing company data*

With ActiveSheet.PivotTables("PivotTable1").PivotFields("PAY TYPE")
.Orientation = xlPageField
.Position = 1
End With
Range("A4").Select
ActiveSheet.PivotTables("PivotTable1").CompactLayoutRowHeader = "PP END DATE"
Range("C3").Select

End Sub

The dates I am trying to filter are "PP END DATE" which I assume is where I am missing some code?

Any suggestions welcome!
 
Upvote 0
The issue is not with you code but with the data in your source data range.

If you create the pivot manually with the same source and source data range you will have the same issue.

Date fields are a bit tricky in a pivot.
If your data has any blanks or text in a Date Field, it prevents you from having access to the Number Formatting.
This is also what is stopping it from showing the underlying date format in the pivot.

In the screen shot below I have set my underlying data to dd-mmm-yyyy. If there are blanks in my data in the date column it defaults to my Region Default date format.
If there are no blanks it picks up the setting I used in my data.

I don't believe there is any way of addressing this anywhere except at the data level.
If the blank date rows are just because your data range is to big, then it is an easy fix.

If it is just the additional blank rows, try replacing this line of code:

VBA Code:
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"AggregateView!R8C1:R300C25", Version:=6).CreatePivotTable TableDestination _
:="WageSummary!R4C1", TableName:="PivotTable1", DefaultVersion:=6

To this

VBA Code:
    Dim rngSource As Range
    Dim shtSource As Worksheet
   
    Set shtSource = ActiveWorkbook.Worksheets("AggregateView")
    Set rngSource = shtSource.Range("A8").CurrentRegion
   
    ' XXXX changed destination from "AggregateView!R8C1:R300C25" to rngSource
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        rngSource, Version:=6).CreatePivotTable TableDestination _
        :="WageSummary!R4C1", TableName:="PivotTable1", DefaultVersion:=6
    Sheets("WageSummary").Select

1627094262469.png
 
Upvote 0
This is brilliant feedback thank you!

I do have additional blank rows in my range that is outside the data, because every data source is a difference size so I just chose A8:Y500 as default which leaves blank rows at the bottom of all my raw data sheets.

I replaced the code you suggested and got "Run Time 1004 - The PivotTable field name is not valid. To create a valid pivot table report, you must use data that is organized as a list with labeled columns. If you are changing the name of a pivot field, you must type a new name for the field"

This is not an error code I expected to get, since my data headers start on row A8 which should be included in the code. My understanding is that the Range/Current Region code you listed above will select all cells around it that contain data? If so, there are 5 cells above row A8 that contain data that's not needed on the pivot table, so maybe it's picking that up?

Also, the error is highlighting this section of code:
VBA Code:
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        rngSource, Version:=6).CreatePivotTable TableDestination _
        :="WageSummary!R4C1", TableName:="PivotTable1", DefaultVersion:=6
Which is not where I would expect the error to occur...

My only other thought would be using a different way to copy the raw wages to paste to the second page.. Any additional thoughts with this extra info?
 
Upvote 0
When it errors out can you put this in the immediate window?

? shtSource.Range("A8").CurrentRegion.address

And check if it looks right.

Otherwise please provide an xl2bb of some rows with the headings.
 
Upvote 0
The above reply was from my phone in case you were still online (I am in Australia Timezone wise).

Here is a more complete and more considered response.

CurrentRegion uses blank rows and columns as a border, so if you have rows with data directly above A8 is will pick those up too.
You can test this.
Select A8 and hit ctrl+shift+8 (ctrl+*)
That will highlight the range it will pick up.

If you can insert a blank row above A8 then the only change you need to make the code is to change A8 for A9 since it has now been pushed down 1 row.

If you are importing the data or have some other reason not to want to insert a row then the code below takes a different somewhat longer approach.

I might have made a bit of a meal of this in trying to make sure that if you needed to change the A8 to something else, that would only need to change it in once place.

VBA Code:
    Dim rngSource As Range
    Dim shtSource As Worksheet
    Dim lastRow As Long
    Dim lastCol As Long
    
    Const startCell As String = "A8"
        
    Set shtSource = ActiveWorkbook.Worksheets("AggregateView")
    Set rngSource = shtSource.Range(startCell)      ' Initial setting to top left corner
    
    With shtSource
        lastRow = .Cells(.Rows.Count, rngSource.Column).End(xlUp).Row
        lastCol = .Cells(rngSource.Row, .Columns.Count).End(xlToLeft).Column
        ' Resize to full range
        Set rngSource = .Range(startCell, .Cells(lastRow, lastCol))
    End With
 
   ' XXXX no change from here
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        rngSource, Version:=6).CreatePivotTable TableDestination _
        :="WageSummary!R4C1", TableName:="PivotTable1", DefaultVersion:=6
    Sheets("WageSummary").Select
 
Upvote 0
First, I just want to thank you again for taking the time to respond to my thread, you've been incredibly helpful!

I tried a couple things based on your suggestions and got the same outcome. Here is what I tried:

This is keeping the previous code the same but inserting a row above A8 to separate the data and create a blank row border

VBA Code:
Dim OpenBook As Workbook
FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.xls*),*xls*")
If FileToOpen <> False Then
Set OpenBook = Application.Workbooks.Open(FileToOpen)
OpenBook.Worksheets("Aggregate View").Range("A1:Y300").Copy
ThisWorkbook.Worksheets("AggregateView").Range("A1").PasteSpecial xlPasteValues
OpenBook.Close False
End If
Range("A8").EntireRow.Insert
'The following line will run Macro2
Call WageSummaryPivotTableVersion1_1
End Sub

Sub WageSummaryPivotTableVersion1_1()
'
' WageSummaryPivotTableVersion1_1 Macro
' Creates Updated Pivot Table for Version 1.1
'

'
Dim rngSource As Range
Dim shtSource As Worksheet
Set shtSource = ActiveWorkbook.Worksheets("AggregateView")
Set rngSource = shtSource.Range("A9").CurrentRegion
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
rngSource, Version:=6).CreatePivotTable TableDestination _
:="WageSummary!R4C1", TableName:="PivotTable1", DefaultVersion:=6
Sheets("WageSummary").Select

When running this, it changes the raw data page to be in date format, and creates a pivot table of the correct range. BUT the pivot table still does not sort by date and is in general format…. I was hopeful this would be the fix since it did successfully remove blanks in the pivot table/date field, and the data source is in date format. However, the field settings number format option that you showed in the screenshot is not available, so I think there is still a hole in the translation somewhere..

So then I also tried replacing the entire section of code with what you suggested here:
VBA Code:
Dim rngSource As Range
Dim shtSource As Worksheet
Dim lastRow As Long
Dim lastCol As Long

Const startCell As String = "A9"

Set shtSource = ActiveWorkbook.Worksheets("AggregateView")
Set rngSource = shtSource.Range(A9)


With shtSource
lastRow = .Cells(.Rows.Count, rngSource.Column).End(xlUp).Row
lastCol = .Cells(rngSource.Row, .Columns.Count).End(xlToLeft).Column
Set rngSource = .Range(A9, Y300)
End With
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
rngSource, Version:=6).CreatePivotTable TableDestination _
:="WageSummary!R4C1", TableName:="PivotTable1", DefaultVersion:=6
Sheets("WageSummary").Select

I tried my best to interpret the notes and adjust it to my data accordingly, and I think I did alright. (Basically data range selected is standard A8-Y300 or A9-Y300 with the extra row added to break up the data) but unfortunately this code had the same outcome as what I listed above as well – it changed the source data, but not the pivot table.. ☹

I am really hoping you can spot a simple error somewhere, and that we are still on a hot lead for a potential fix..

Thank you again for taking the time to help me work this out!
 
Upvote 0
In the second method you need to replace:
VBA Code:
Set rngSource = .Range(A9, Y300)

With this:-
VBA Code:
        ' Resize to full range
        Set rngSource = .Range(startCell, .Cells(lastRow, lastCol))

And and least for now replace:
VBA Code:
Set rngSource = shtSource.Range(A9)

With this:-
VBA Code:
    Set rngSource = shtSource.Range(startCell)      ' Initial setting to top left corner
 
Upvote 0
You need to tackle it as 2 separate steps though, no point in constantly rerunning the macro when it is not a macro problem:

1) Is the macro setting the correct range ?
Use either of the 2 methods eg CurrentRegion or LastRow/Column.​
After you have run the macro go to the pivot table​
Check the Data Source​
ie PivotTable Analyze > Change Data Source > Change Data Source​
Does this match where the underlying data starts and finishes.​
If yes the macro has done its job.​
Proceed to step 2, otherwise sort this part out first.​

2) Checking for Data issues - Pivot Table / Data troubleshooting (not macro troubleshooting)
In the pivot table > go to the field settings for "PP END DATE" can you see the Number Format button in the bottom left.​
If yes you should be getting the right date format or be able to change it and sorting should show oldest to newest and vice versa and work the way you expect it to.​
If you still can't see the Number Format button, then it should mean there is data in your "PP END DATE" column that is not being recognized as a data.​
These will should show at the Top or Bottom of any list using them which includes​
  • the PP END DATE in the pivot table
  • the PP END DATE filter in the pivot table
  • the PP END DATE column filter in the AggregateView Data Sheet
    (unless the number of individiual dates is so long that it doesn't show them all in the filter)
Assuming you find some invalid dates, you will then need to figure out what you can do to fix the. The pivot will not treat the column as a date field while there are blanks or text (non-dates) in the column.​
3) Couldn't find it ? next step.
If you can't find the issue, see if you can create a publicly accessible link to a copy of the file and we can have a look.​
We don't need any of the data EXCEPT for the date column which needs to have the real undoctored data in it, since we are looking for a data issue.​
(Pay Type field data would be handy but not essential)​
Make sure you also clear the WageSummary so its empty, so the data you have removed from the AggregateView is not still sitting in the Pivot cache.​

PS: It would be handy to know what timezone you are in.
 
Upvote 0
Solution

Forum statistics

Threads
1,223,884
Messages
6,175,175
Members
452,615
Latest member
bogeys2birdies

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top