VBA-automatically moving graph labels above the bar if positive and below if negative?

[hmmmidk220]

I have a waterfall based on a line graph with up/down bars. (Excel Waterfall Charts (Bridge Charts) - Peltier Tech Blog)

Basically,

The bars on my graph track changes. The only label displayed above/below each bar is a label that says the amount of the change. This is on a hidden secondary axis and is based on a series independent of the actual bars.

I don't know if that makes sense or not lol but is there a VBA solution to make labels align above a bar if the value of the label is positive and below the bar if the value is negative?

 

[Worf]

Try this one:

Sub UpDown()
Dim cht As Chart, s1 As Series, s2 As Series, yv1, yv2, i%
Set cht = ActiveChart
Set s1 = cht.SeriesCollection(2)                                ' beginning
Set s2 = cht.SeriesCollection(3)                                ' ending
s1.HasDataLabels = False
s2.HasDataLabels = True
With s2.DataLabels
    .Font.Bold = 1
    .Font.Size = 12
    .Position = xlLabelPositionCenter                           ' above or below bars
End With
yv1 = s1.Values
yv2 = s2.Values
For i = 1 To UBound(yv1)
    s2.DataLabels(i).Text = yv2(i) - yv1(i)                     ' amount of change
    Select Case yv2(i) - yv1(i)
        Case Is > 0
            s2.DataLabels(i).Top = s2.DataLabels(i).Top - 10    ' fine tune position
        Case Is < 0
            s2.DataLabels(i).Top = s2.DataLabels(i).Top + 10
    End Select
Next
End Sub

 

[hmmmidk220]

Try this one:

Sub UpDown()
Dim cht As Chart, s1 As Series, s2 As Series, yv1, yv2, i%
Set cht = ActiveChart
Set s1 = cht.SeriesCollection(2)                                ' beginning
Set s2 = cht.SeriesCollection(3)                                ' ending
s1.HasDataLabels = False
s2.HasDataLabels = True
With s2.DataLabels
    .Font.Bold = 1
    .Font.Size = 12
    .Position = xlLabelPositionCenter                           ' above or below bars
End With
yv1 = s1.Values
yv2 = s2.Values
For i = 1 To UBound(yv1)
    s2.DataLabels(i).Text = yv2(i) - yv1(i)                     ' amount of change
    Select Case yv2(i) - yv1(i)
        Case Is > 0
            s2.DataLabels(i).Top = s2.DataLabels(i).Top - 10    ' fine tune position
        Case Is < 0
            s2.DataLabels(i).Top = s2.DataLabels(i).Top + 10
    End Select
Next
End Sub

Wow, amazing, so it is possible to do with a macro, thank you!

I'm not sure yet how well it'll work for me though. Here are the problems I see:

1) I think I need a way to clear the previous labels upon running the macro, since the data source is dynamic, the labels will need to be cleared each time the macro is run

2.) I was planning on this being a button next to the graph that a user would hit to set the data labels. But since the source is dynamic, the user might forget to hit the button so I'm looking into making the macro run automatically if any cell in a range of cells (the movement row) changes. I'm looking at something like this: Run Macro on Cell Update. Still learning!

3.) Smaller issue, but I'm trying to figure out how to edit the formatting of the labels further so that they would round to the tenth decimal place always, have parentheses to denote negative values, and have a dollar sign in front of the value.

4.) Also a small issue, but if the amount of change is exactly zero, the zero is placed right on the thin red bar, instead of below or above it. I don't think there's a way to fix this though.

I just wanted to thank you for your help and let you know what I'm currently working on!

 

[Worf]

New version:

Private Sub Worksheet_Change(ByVal Target As Range)                 ' request #2
Dim cht As Chart, s1 As Series, s2 As Series, i%
If Not Intersect(Target, Me.Range("c4:l8")) Is Nothing Then         ' desired range
    Set cht = Me.ChartObjects(1).Chart
    Set s1 = cht.SeriesCollection(2)                                ' beginning
    Set s2 = cht.SeriesCollection(3)                                ' ending
    s2.DataLabels.Delete                                            ' request #1
    s1.HasDataLabels = False
    s2.HasDataLabels = True
    With s2.DataLabels
        .Font.Bold = 1
        .Font.Size = 12
        .Position = xlLabelPositionCenter                           ' above or below bars
    End With
    For i = 2 To 9
        s2.DataLabels(i).Text = [b8].Offset(, i).Text               ' request #3
        Select Case [b8].Offset(, i)
            Case Is > 0
                s2.DataLabels(i).Top = s2.DataLabels(i).Top - 10    ' fine tune position
            Case Is <= 0                                            ' request #4
                s2.DataLabels(i).Top = s2.DataLabels(i).Top + 10
        End Select
    Next
End If
End Sub

 

[Worf]

Note that you must format the row containing the values which are used as data labels:

 

[hmmmidk220]

Thank you so much for your help Worf! That solves all of my problems!! Happy Holidays!!