Vertical Bars in Pivot chart

kvmack47

New Member
Joined
Sep 15, 2020
Messages
1
Office Version
  1. 2013
Platform
  1. Windows
Hi, I am fairly new to pivot charts.
I have data that is plotted by date on the X axis. I want to add vertical bars along the x-axis that show dates of significance. I can of course just draw a line but I need to zoom in and scroll through the timeline. I would like for the vertical bars to move as the data moves.
Here is an example of a chart that I'd like to create with the vertical bars.
PivotChart.PNG

Any help is appreciated.

Kevin
 

Some videos you may like

Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.

pbornemeier

Well-known Member
Joined
May 24, 2005
Messages
3,889
I do not work with pivot charts and so had not noticed before, but it looks like when you make a pivot chart with dates in the X-axis, the sequential date values are spaced linearly, not by their value. Even when I specified that the x-axis was date values instead of text values the graph plotted them at constant intervals, even if the numeric difference between adjacent points was not the same. Your pivot chart starts with gaps of 29, 64, 17 and 11 days but they each cover the same distance as the next. I could not get a pivot table to properly space themselves. At any rate, the following code will take a date and look for the 2 points on the x-axis that are on either side of the date then linearly interpolate between those two points to plot the correct position of that date and draw a line (color and thickness can be specified).

You will have to add a bit of code to read the dates you want to plot from input cells or a form and trigger the subs using one of the PivotTable events.

VBA Code:
Option Explicit

Sub ClearLinesFromChart()

    Dim shp As Shape
    For Each shp In ActiveSheet.ChartObjects(1).Chart.Shapes
        If InStr(shp.Name, "DL_") > 0 Then shp.Delete
    Next
    
End Sub

Sub Test_DrawVerticalLinesOnChart()

    DrawVerticalLinesOnChart (Array(CDate("1/15/17"), 255, 1))
    DrawVerticalLinesOnChart (Array(CDate("3/5/17"), 255, 1.5))
    DrawVerticalLinesOnChart (Array(CDate("6/21/17"), rgbBlue, 4))
    DrawVerticalLinesOnChart (Array(CDate("4/14/14"), 255, 2))
    
End Sub

Function DrawVerticalLinesOnChart(aryInput As Variant)
    'aryInput is a (0 to 2, 1 to n) array with the 0 a date, 1 a long value for color.
    '  (2) a single value for thickness (0.25 to 10)
    'If the date is in the range of teh chart then the line will be plotted
    
    Dim dteMin As Date
    Dim dteMax As Date
    Dim dteInput As Date
    Dim lColor As Long
    Dim sngThick As Single
    Dim sngXIncrementCoord As Single
    Dim sngXCoord As Single
    
    Dim aryXValues As Variant
    Dim lPointCount As Long
    Dim lPointIndex As Long
    Dim sngLowerPointXCoord As Single
    Dim sngLowerPointYCoord As Single
    Dim sngUpperPointXCoord As Single
    Dim sngUpperPointYCoord As Single
    Dim dteLower As Date
    Dim dteUpper As Date
    Dim bSkip As Boolean
    Dim lLowerPoint As Long
    Dim lUpperPoint As Long
    
    dteInput = aryInput(0)
    lColor = aryInput(1)
    sngThick = aryInput(2)
    
    aryXValues = ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1).XValues
    
    For lPointIndex = LBound(aryXValues) To UBound(aryXValues)
        aryXValues(lPointIndex) = CDate(aryXValues(lPointIndex))
    Next
    For lPointIndex = LBound(aryXValues) To UBound(aryXValues) - 1
        If dteInput = aryXValues(lPointIndex) Then
            lLowerPoint = lPointIndex
            lUpperPoint = lPointIndex
            Exit For
        End If
        If dteInput > aryXValues(lPointIndex) And dteInput < aryXValues(lPointIndex + 1) Then
            lLowerPoint = lPointIndex
            Exit For
        End If
    Next
    If lLowerPoint = 0 Then
        'Date not in graph range
        bSkip = True
    ElseIf lLowerPoint = lUpperPoint Then
        sngXCoord = ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1).Points(lLowerPoint).Left
    ElseIf lLowerPoint < UBound(aryXValues) Then
        'Specified date is between two points on the chart
        dteLower = aryXValues(lLowerPoint)
        dteUpper = aryXValues(lLowerPoint + 1)
        sngLowerPointXCoord = ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1).Points(lLowerPoint).Left
        sngUpperPointXCoord = ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1).Points(lLowerPoint + 1).Left
        sngXIncrementCoord = (sngUpperPointXCoord - sngLowerPointXCoord) * (dteInput - dteLower) / (dteUpper - dteLower)
        sngXCoord = sngLowerPointXCoord + sngXIncrementCoord
    End If
        
    If Not bSkip Then
        bSkip = False
        ActiveSheet.ChartObjects(1).Select
        With ActiveSheet.ChartObjects(1).Chart.PlotArea
            sngUpperPointYCoord = .Top
            sngLowerPointYCoord = sngUpperPointYCoord + .InsideHeight
        End With
        ActiveChart.Shapes.AddConnector(msoConnectorStraight, _
            sngXCoord, sngUpperPointYCoord, sngXCoord, sngLowerPointYCoord).Select
        With Selection.ShapeRange.Line
            .Visible = msoTrue
            .ForeColor.RGB = lColor
            .Transparency = 0
            .Weight = sngThick
        End With
        Selection.ShapeRange.Name = "DL_" & sngXCoord

    End If
        
End Function
 

Watch MrExcel Video

Forum statistics

Threads
1,127,348
Messages
5,624,145
Members
416,014
Latest member
MickP69

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
Top