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

hmmmidk220

Board Regular
Joined
Dec 14, 2016
Messages
55
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?
 

Excel Facts

How to calculate loan payments in Excel?
Use the PMT function: =PMT(5%/12,60,-25000) is for a $25,000 loan, 5% annual interest, 60 month loan.
If you are comparing two series with up and down bars, data labels for the second series will be in the correct positions to show the amount of change. The code below does that:Sorry all, problems with the code tags... Root cause is bad Internet connection...Sub UpDown()Dim cht As Chart, s1 As Series, s2 As Series, yv1, yv2, i%Set cht = ActiveChartSet s1 = cht.SeriesCollection(1) ' first seriesSet s2 = cht.SeriesCollection(2) ' second seriess1.HasDataLabels = Falses2.HasDataLabels = TrueWith s2.DataLabels .Font.Bold = 1 .Font.Size = 12 .Position = xlLabelPositionCenterEnd Withyv1 = s1.Valuesyv2 = s2.ValuesFor 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 SelectNextEnd Sub
 
Last edited:
Upvote 0
A decent posting format:

Code:
Sub UpDown()
Dim cht As Chart, s1 As Series, s2 As Series, yv1, yv2, i%
Set cht = ActiveChart
Set s1 = cht.SeriesCollection(1)                                ' first series
Set s2 = cht.SeriesCollection(2)                                ' second series
s1.HasDataLabels = False
s2.HasDataLabels = True
With s2.DataLabels
    .Font.Bold = 1
    .Font.Size = 12
    .Position = xlLabelPositionCenter
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
 
Upvote 0
It would look like this:

updown.JPG
 
Upvote 0
Upvote 0
Can you post a link to your test workbook, so I can use the real chart?
If I create my version, some differences may exist.
 
Upvote 0
Got the file! Will work on it as soon as possible, busy week as always... :rolleyes:
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,205
Members
448,554
Latest member
Gleisner2

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
Back
Top