Vertical Bars in Pivot chart

[kvmack47]

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.

Any help is appreciated.

Kevin

 

[pbornemeier]

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.

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