VBA code to position data labels on top of the stacks in a stacked columns chart

N

NiceLittleRabbit

New Member
Joined
Sep 7, 2009
Messages
4
Hello,

While further refining my waterfall VBA code, I could not find the way to position the data labels on top of the stacks. And of course, the labels are often positioned in the stacks themselves, making them difficult to read and very ugly to watch.

Is there a way to request the labels to be on top of the stacks?

Here comes my code, in which data labels are displayed only if they are different from zero. I have a file ready to be tested, but could not find a way to attach it to this post, so if you PM me I can send it out. However, the code below is the same as the one in the worksheet.

Help on this would, as usual, be MUCH appreciated

Thank you in advance

My worksheet "Global" looks like this (some random data), starting row 3:

<table width="192" border="0" cellpadding="0" cellspacing="0"><colgroup><col style="mso-width-source:userset;mso-width-alt:3271;width:69pt" width="92"> <col style="mso-width-source:userset;mso-width-alt:1792; width:38pt" span="2" width="50"> </colgroup><tbody><tr style="height:14.4pt" height="19"> <td style="height:14.4pt;width:69pt" width="92" height="19">A</td> <td style="width:38pt" width="50" align="right">0</td> <td style="width:38pt" width="50" align="right">0</td> </tr> <tr style="height:14.4pt" height="19"> <td style="height:14.4pt" height="19">B</td> <td align="right">0</td> <td align="right">0</td> </tr> <tr style="height:14.4pt" height="19"> <td style="height:14.4pt" height="19">C</td> <td align="right">0</td> <td align="right">0</td> </tr> <tr style="height:14.4pt" height="19"> <td style="height:14.4pt" height="19">D</td> <td align="right">0</td> <td align="right">0</td> </tr> <tr style="height:14.4pt" height="19"> <td style="height:14.4pt" height="19">E</td> <td align="right">53440</td> <td align="right">48614</td> </tr> <tr style="height:14.4pt" height="19"> <td style="height:14.4pt" height="19">F</td> <td align="right">148629</td> <td align="right">171081</td> </tr> <tr style="height:14.4pt" height="19"> <td style="height:14.4pt" height="19">G</td> <td align="right">3540</td> <td align="right">4075</td> </tr> <tr style="height:14.4pt" height="19"> <td style="height:14.4pt" height="19">H</td> <td align="right">48139</td> <td align="right">39893</td> </tr> <tr style="height:14.4pt" height="19"> <td style="height:14.4pt" height="19">I</td> <td align="right">4525</td> <td align="right">5795</td> </tr> <tr style="height:14.4pt" height="19"> <td style="height:14.4pt" height="19">J</td> <td align="right">6773</td> <td align="right">3077</td> </tr> <tr style="height:14.4pt" height="19"> <td style="height:14.4pt" height="19">K</td> <td align="right">6319</td> <td align="right">2471</td> </tr> <tr style="height:14.4pt" height="19"> <td style="height:14.4pt" height="19">L</td> <td align="right">1828</td> <td align="right">674</td> </tr> <tr style="height:14.4pt" height="19"> <td style="height:14.4pt" height="19">M</td> <td align="right">230</td> <td align="right">433</td> </tr> <tr style="height:14.4pt" height="19"> <td style="height:14.4pt" height="19">N</td> <td align="right">6239</td> <td align="right">204</td> </tr> <tr style="height:14.4pt" height="19"> <td style="height:14.4pt" height="19">O</td> <td align="right">0</td> <td align="right">1360</td> </tr> <tr style="height:14.4pt" height="19"> <td style="height:14.4pt" height="19">P</td> <td align="right">0</td> <td align="right">382</td> </tr> <tr style="height:14.4pt" height="19"> <td style="height:14.4pt" height="19">Q</td> <td align="right">24451</td> <td align="right">0</td> </tr> <tr style="height:14.4pt" height="19"> <td style="height:14.4pt" height="19">R</td> <td align="right">423</td> <td align="right">1465</td> </tr> <tr style="height:14.4pt" height="19"> <td style="height:14.4pt" height="19">S</td> <td align="right">1004</td> <td align="right">5250</td> </tr> <tr style="height:14.4pt" height="19"> <td style="height:14.4pt" height="19">T</td> <td align="right">750</td> <td align="right">6024</td> </tr> <tr style="height:14.4pt" height="19"> <td style="height:14.4pt" height="19">U</td> <td align="right">288</td> <td align="right">33763</td> </tr> </tbody></table>

Code: 
Public Sub DrawWaterfallChart()

Dim SheetName As String
Dim Data1Col As Integer, Data2Col As Integer, LabelsCol As Integer
Dim FirstRow As Long, LastRow As Long

LabelsCol = 1
Data1Col = 2
Data2Col = 3
FirstRow = 3
LastRow = 23

SheetName = "Global"


Dim rng1 As Range, rng2 As Range, rnglabels As Range, rngGlobal As Range

Dim myChtObj As ChartObject
Dim iColumn As Long

Dim plus() As Double
Dim minus() As Double
Dim basement() As Double
Dim labels() As String
Dim Height As Long
Height = LastRow - FirstRow + 1
Dim Initial As Double

'Let's put the data in arrays because in the final application the data will be coming from arrays

ReDim plus(1 To Height)
ReDim minus(1 To Height)
ReDim basement(1 To Height)
ReDim labels(1 To Height)

Dim Row As Long, Col As Integer

For Row = 1 To Height
    If Sheets(SheetName).Cells(FirstRow + Row - 1, Data2Col) > Sheets(SheetName).Cells(FirstRow + Row - 1, Data1Col) Then
        plus(Row) = Sheets(SheetName).Cells(FirstRow + Row - 1, Data2Col) - Sheets(SheetName).Cells(FirstRow + Row - 1, Data1Col)
        minus(Row) = 0
    Else
        plus(Row) = 0
        minus(Row) = -Sheets(SheetName).Cells(FirstRow + Row - 1, Data2Col) + Sheets(SheetName).Cells(FirstRow + Row - 1, Data1Col)
    End If
Next Row

For Row = 1 To UBound(plus)
    If plus(Row) > 0 Then
        basement(Row) = Sheets(SheetName).Cells(FirstRow + Row - 1, Data2Col)
    Else
        basement(Row) = Sheets(SheetName).Cells(FirstRow + Row - 1, Data1Col)
    End If
    labels(Row) = Sheets(SheetName).Cells(FirstRow + Row - 1, LabelsCol)
Next Row

Set myChtObj = Sheets(SheetName).ChartObjects.Add(Left:=250, Width:=375, Top:=75, Height:=225)

Dim Invisible As Series
    
Dim Positive As Series
    
Dim Negative As Series

' Add the chart
With myChtObj.Chart
    .ChartArea.Fill.Visible = False
    .PlotArea.Format.Fill.Solid
    .PlotArea.Format.Fill.Transparency = 1
    .HasTitle = True
    .HasLegend = False
    
    .ChartTitle.Text = "My chart"
        
    .Axes(xlCategory, xlPrimary).HasTitle = True
    .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Units"
    .Axes(xlValue, xlPrimary).HasTitle = True
    .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Quantity"
    
    
    .ChartGroups(1).GapWidth = 0

    ' Make Column Stacked chart
    .ChartType = xlColumnStacked
    
    ' Add series from selected range, column by column
    Set Invisible = .SeriesCollection.NewSeries
    With Invisible
        .Values = basement
        .XValues = labels
        .Name = "Labels"
        With .Border
            .ColorIndex = 13
            .Weight = xlMedium
            .LineStyle = xlNone
        End With
        .Format.Fill.Visible = False
        .Format.Line.Transparency = 0
        .MarkerStyle = xlNone
    End With
    
    Set Positive = .SeriesCollection.NewSeries
    With Positive
        .Values = plus
        .XValues = labels
        .Name = "Plus"
        .Interior.ColorIndex = 14
    
        .HasDataLabels = False
    End With
    
    nPts = Positive.Points.Count 'save the number of points
    aVals = Positive.Values 'save all the values in array

    For Col = 1 To nPts ' loop through all points
        If aVals(Col) > 0 Then
            t = "+" & CStr(Round(aVals(Col)))
            Positive.Points(Col).HasDataLabel = True
            With Positive.Points(Col).DataLabel
                .Text = t
                ' Here I'd like to be able to request the data label to be above the stack (xlLabelPositionAbove)
                .Position = 4 'Only accepts 3 (xlLabelPositionInsideEnd) and 4 (xlLabelPositionInsideBase)
                With .Font
                    .ColorIndex = 14
                    .Size = 6
                End With
            End With
        End If
    Next Col

            
    Set Negative = .SeriesCollection.NewSeries
    With Negative
        .Values = minus
        .XValues = labels
        .Name = "Minus"
        .Interior.ColorIndex = 18
    End With
    
    nPts = Negative.Points.Count 'save the number of points
    aVals = Negative.Values 'save all the values in array

    For Col = 1 To nPts ' loop through all points
        If aVals(Col) > 0 Then
            t = "-" & CStr(Round(aVals(Col)))
            Negative.Points(Col).HasDataLabel = True
            With Negative.Points(Col).DataLabel
                .Text = t
                ' Here I'd like to be able to request the data label to be above the stack (xlLabelPositionAbove)
                .Position = 4 'Only accepts 3 (xlLabelPositionInsideEnd) and 4 (xlLabelPositionInsideBase)
                With .Font
                    .ColorIndex = 18
                    .Size = 6
                End With
            End With
        End If
    Next Col
        
End With

End Sub
 

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.
Sort by date Sort by votes
Once again, problem solved thanks to Andy Pope, from http://www.excelforum.com

I upload the macro (not very nice code, but you can personalize if you want) to draw waterfall charts with data labels on top of the stacks.

Enjoy!!

The code:

Code: 
Public Sub Draw()

Dim SheetName As String
Dim Data1Col As Integer, Data2Col As Integer, LabelsCol As Integer
Dim FirstRow As Long, LastRow As Long

LabelsCol = 1
Data1Col = 2
Data2Col = 3
FirstRow = 3
LastRow = 23

SheetName = "Global"

DrawWaterfallChart SheetName, Data1Col, Data2Col, LabelsCol, FirstRow, LastRow

End Sub
___________________________________________________
Public Sub DrawWaterfallChart(SheetName As String, Data1Col As Integer, Data2Col As Integer, LabelsCol As Integer, FirstRow As Long, LastRow As Long)

Dim rng1 As Range, rng2 As Range, rnglabels As Range, rngGlobal As Range

Dim myChtObj As ChartObject
Dim iColumn As Long

Dim plus() As Double
Dim minus() As Double
Dim basement() As Double
Dim labels() As String
Dim Height As Long
Height = LastRow - FirstRow + 1
Dim Initial As Double

'Let's put the data in arrays because in the final application the data will be coming from arrays

ReDim plus(1 To Height)
ReDim minus(1 To Height)
ReDim basement(1 To Height)
ReDim labels(1 To Height)

Dim Row As Long, Col As Integer

For Row = 1 To Height
    If Sheets(SheetName).Cells(FirstRow + Row - 1, Data2Col) > Sheets(SheetName).Cells(FirstRow + Row - 1, Data1Col) Then
        plus(Row) = Sheets(SheetName).Cells(FirstRow + Row - 1, Data2Col) - Sheets(SheetName).Cells(FirstRow + Row - 1, Data1Col)
        minus(Row) = 0
    Else
        plus(Row) = 0
        minus(Row) = -Sheets(SheetName).Cells(FirstRow + Row - 1, Data2Col) + Sheets(SheetName).Cells(FirstRow + Row - 1, Data1Col)
    End If
Next Row

For Row = 1 To UBound(plus)
    If plus(Row) > 0 Then
        basement(Row) = Sheets(SheetName).Cells(FirstRow + Row - 1, Data2Col)
    Else
        basement(Row) = Sheets(SheetName).Cells(FirstRow + Row - 1, Data1Col)
    End If
    labels(Row) = Sheets(SheetName).Cells(FirstRow + Row - 1, LabelsCol)
Next Row

Dim StringLabels() As String
ReDim StringLabels(1 To Height)

For Row = 1 To UBound(StringLabels)
    If plus(Row) > 0 Then
        StringLabels(Row) = "-" & CStr(Round(plus(Row)))
    ElseIf minus(Row) > 0 Then
        StringLabels(Row) = "+" & CStr(Round(minus(Row)))
    Else
        StringLabels(Row) = ""
    End If
Next Row

Dim LabelValues() As Double
ReDim LabelValues(1 To Height) As Double

For Row = 1 To UBound(LabelValues)
    LabelValues(Row) = basement(Row) + plus(Row) + minus(Row)
Next Row

Set myChtObj = Sheets(SheetName).ChartObjects.Add(Left:=250, Width:=375, Top:=75, Height:=225)

Dim Invisible As Series
Dim Positive As Series
Dim Negative As Series
Dim InvisibleLineLabels As Series

Dim Pts As Points
Dim Pt As Point

' Add the chart
With myChtObj.Chart
    .ChartArea.Fill.Visible = False
    .PlotArea.Format.Fill.Solid
    .PlotArea.Format.Fill.Transparency = 1
    .HasTitle = True
    .HasLegend = False
    
    .ChartTitle.Text = "My chart"
        
    .Axes(xlCategory, xlPrimary).HasTitle = True
    .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Units"
    .Axes(xlValue, xlPrimary).HasTitle = True
    .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Quantity"
    
    
    .ChartGroups(1).GapWidth = 0

    ' Make Column Stacked chart
    .ChartType = xlColumnStacked
    
    ' Add series from selected range, column by column
    Set Invisible = .SeriesCollection.NewSeries
    With Invisible
        .Values = basement
        .XValues = labels
        .Name = "Labels"
        With .Border
            .ColorIndex = 13
            .Weight = xlMedium
            .LineStyle = xlNone
        End With
        .Format.Fill.Visible = False
        .Format.Line.Transparency = 0
        .MarkerStyle = xlNone
        .HasDataLabels = False
    End With
    
    Set Positive = .SeriesCollection.NewSeries
    With Positive
        .Values = plus
        .XValues = labels
        .Name = "Plus"
        .Interior.ColorIndex = 14
        .HasDataLabels = False
    End With
    
    Set Negative = .SeriesCollection.NewSeries
    With Negative
        .Values = minus
        .XValues = labels
        .Name = "Minus"
        .Interior.ColorIndex = 18
        .HasDataLabels = False
    End With

    
    Set InvisibleLineLabels = .SeriesCollection.NewSeries
    With InvisibleLineLabels
        .Type = xlLine
        .Values = LabelValues
        .XValues = labels
        .Name = "Labels"
        With .Border
            .LineStyle = xlNone
        End With
        .Format.Fill.Visible = False
        .MarkerStyle = xlNone
        .HasDataLabels = True
    End With
    
    Set Pts = InvisibleLineLabels.Points
    
    Row = 0
    For Each Pt In Pts
        Row = Row + 1
        Pt.DataLabel.Text = StringLabels(Row)
        Pt.DataLabel.Font.Bold = False
        Pt.DataLabel.Font.Size = 6
        Pt.DataLabel.Position = xlLabelPositionAbove
    Next Pt
        
End With

End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Question
Problems Encountered When Generating VBA Excel Charts with 15-Minute Interval Data.
Replies
0
Views
169
dilshod_k
D
J
  • Question
Moving duplicate Column Data to individual rows in VBA
Replies
4
Views
219
Peter_SSs
Peter_SSs
M
  • Question
VBA for a Profit Calculation
Replies
2
Views
303
mollerrr
M
T
  • Solved
Data labels for stack column chart
Replies
1
Views
310
thomas819
T
E
  • Question
Stack first 100 rows of 4 column group on top of each other VBA
Replies
1
Views
319
Peter_SSs
Peter_SSs

Forum statistics

Threads
1,215,480
Messages
6,125,049
Members
449,206
Latest member
Healthydogs

Share this page

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