Highlight columns in pivot table based on grouped dates

[chally3]

Good morning all,

Ive been searching the net to find an answer to see if this is possible and have drawn a blank.
I have a pivot table that groups data by "qty due" & "date due" (grouped into working weeks across the columns) and was wandering if its possible to highlight the columns that are l<'end of current working week' and also highlight the columns that are >"end of the current working week" and <="end of the following working week"
Column D , row 4 is the first consolidated week columns (number of rows vary depending on the date extracted which I pivot.

Grouping by weeks is essential


Any help appreciated as ever. Thank you

 

[Worf]

Good evening

The example below highlights columns with dates earlier than the current week. It assumes column labels in the format “01/08/18 – 08/08/18”.

Sub HLight()
Dim pt As PivotTable, r As Range, i%, rn%
Set pt = ActiveSheet.PivotTables("pivot4")      ' your table name here
Set r = pt.ColumnRange
rn = Split(pt.DataBodyRange.Address, "$")(4)
For i = 1 To r.Columns.Count - 1
    If WorksheetFunction.WeekNum(CDate(Split(r.Cells(2, i), "-")(1))) - _
    WorksheetFunction.WeekNum(Now) < 0 Then _
    Range(r.Cells(2, i), Cells(rn, r.Cells(2, i).Column)).Interior.Color = vbYellow
Next
End Sub

 

[chally3]

Good evening

The example below highlights columns with dates earlier than the current week. It assumes column labels in the format “01/08/18 – 08/08/18”.

Sub HLight()
Dim pt As PivotTable, r As Range, i%, rn%
Set pt = ActiveSheet.PivotTables("pivot4")      ' your table name here
Set r = pt.ColumnRange
rn = Split(pt.DataBodyRange.Address, "$")(4)
For i = 1 To r.Columns.Count - 1
    If WorksheetFunction.WeekNum(CDate(Split(r.Cells(2, i), "-")(1))) - _
    WorksheetFunction.WeekNum(Now) < 0 Then _
    Range(r.Cells(2, i), Cells(rn, r.Cells(2, i).Column)).Interior.Color = vbYellow
Next
End Sub

A diamond sir

 

[chally3]

Hi Worf,

Ive tried pasting the VBA and changed Set pt = ActiveSheet.PivotTables("pivot4") to Set pt = ActiveSheet.PivotTables("Stands") and I get a Runtime error '1004'; application-defined or object defined error.
Any suggestions?

Thank you
Mark

 

[Worf]

Hi Mark

Try the code below and see if “Stands” appears. Note that the first version refers to the active sheet.

 Sub PTables()
Dim ws As Worksheet, i%
Set ws = Sheets("data")             ' your sheet name here
For i = 1 To ws.PivotTables.Count
    MsgBox ws.PivotTables(i).Name
Next
End Sub

 

[chally3]

Hi Worf, apologies for the delay, I've just had time to trial the code.
All I see when I run the code is 2 pop up boxes, saying pivottable4 & then pivottable3. No columns are highlighted

 

[Worf]

New version:

Sub HLight()
Dim pt As PivotTable, r As Range, i%, ws As Worksheet
Set ws = Sheets("data")
Set pt = ws.PivotTables("pivot4")      ' replace both names here
Set r = pt.ColumnRange
For i = 1 To r.Columns.Count - 1
    If WorksheetFunction.WeekNum(CDate(Split(r.Cells(2, i), "-")(1))) - _
    WorksheetFunction.WeekNum(Now) < 0 Then _
    ws.Range(r.Cells(2, i), ws.Cells(Split(pt.DataBodyRange.Address, "$")(4), _
    r.Cells(2, i).Column)).Interior.Color = vbYellow
Next
End Sub