Conditional shading of chart areas in Excel

Question

I have a chart of interest rates over time and I would like to shade multiple areas of the chart based on conditions that I specify.

Is there a way to do this automatically by specifying the criteria in the data that would determine the areas to be shaded?

First, shade a rectangular area of the chart between the dates of March 2001 and November 2001 to indicate the recession after the dotcom bubble.

Second, shade a rectangular area of the chart between the dates of December 2007 and June 2009 to indicate the recession after the global financial crisis.  So, the first 2 shadings are based on time criteria on the horizontal axis.

Third, shade a rectangular area of the chart in red where the interest rates are below zero.  This is based on the vertical axis where numeric values are less than or equal zero.

I have been able to manually shade these areas on the chart by creating semi-transparent rectangles and manually grabbing the corners and edges to fit them over the chart area in the desired locations.  Then if I change something on the chart like add an axis title which changes the size of the chart I have to manually fix the semi-transparent rectangles so the edges align with the data I am describing.

Here is a screenshot that shows the 3 areas to be shaded.  I shaded them by manually creating rectangular overlays but would like to find a way to automate the shading based on the data.  If Excel 2016 does not currently have this feature I would like to suggest that it be added.  Thanks.

Answer 1

would like to find a way to automate the shading based on the data.

That can be done with a macro and another chart series.

The data of your chart has 3 data columns, 1st contains the date, the next 2 the data.

You can add a data column, with the min and max value. Add that column to your chart, then change the chart style for that series to a column chart.

After that we can determine the coordinates for the rectangle and create it with a macro.

Quick and dirty code is below.

Andreas.

Option Explicit

Sub Test()

  Dim C As Chart

  Dim S As Series

  Dim P As Point

  Dim B As Single, T As Single, L As Single, R As Single

  Dim Sh As Shape

  Set C = ActiveSheet.ChartObjects(1).Chart

  For Each Sh In C.Shapes

    Sh.Delete

  Next

  Set S = C.SeriesCollection(3)

  For Each P In S.Points

    If P.Height = 0 Then

      If T = 0 Then

        B = P.Top

      Else

        Set Sh = DrawRectangle(L, B, R, T, 0, C)

        With Sh

          With .Fill

            .Visible = msoTrue

            .ForeColor.ObjectThemeColor = msoThemeColorBackground1

            .ForeColor.Brightness = -0.5

            .Transparency = 0.75

          End With

          With .Line

            .ForeColor.ObjectThemeColor = msoThemeColorBackground1

            .ForeColor.Brightness = -0.5

            .Transparency = 0.75

          End With

        End With

        S.Format.Line.Visible = msoFalse

        S.Format.Fill.Visible = msoFalse

        Exit For

      End If

    Else

      If T = 0 Then

        T = P.Top

        L = P.Left

      End If

      R = P.Left

    End If

  Next

End Sub

Function DrawRectangle(ByVal X1 As Double, ByVal Y1 As Double, ByVal X2 As Double, ByVal Y2 As Double, _

    Optional ByVal Angle As Double, Optional ByVal Parent As Object) As Shape

  'Draws a rectangle from X1,Y1 to X2,Y2 under Angle (X+ = 0°)

  Dim Temp As Double

  If Parent Is Nothing Then Set Parent = ActiveSheet

  If X1 > X2 Then Temp = X1: X1 = X2: X2 = Temp

  If Y1 > Y2 Then Temp = Y1: Y1 = Y2: Y2 = Temp

  If X2 - X1 + Y2 - Y1 = 0 Then Exit Function

  Set DrawRectangle = Parent.Shapes.AddShape(msoShapeRectangle, X1, Y1, X2 - X1, Y2 - Y1)

  With DrawRectangle

    .Rotation = Angle

    .Fill.Visible = msoFalse

    With .Line

      .Weight = 1

      .ForeColor.RGB = 0

    End With

  End With

End Function