Finance

Charts

Statistics

Macros

Search

Creating a bullet chart in Excel VBA

Since Excel does not have a built-in « bullet chart » type, we can simulate this using shapes (rectangles) to represent the bullet chart style.

Main Steps:

  1. Create a dataset with values that will be displayed as bullets.
  2. Insert bars (e.g., horizontal rectangles) to simulate the bullets.
  3. Format these bars to look like a bullet chart.

Example VBA Code to Create a Bullet Chart:

Sub CreateBulletChart()
    Dim ws As Worksheet
    Dim i As Integer
    Dim dataRange As Range
    Dim bulletWidth As Double
    Dim maxLength As Double
    Dim maxValue As Double
    Dim rect As Shape   
    ' Create a new worksheet for the chart
    Set ws = ThisWorkbook.Sheets.Add
    ws.Name = "BulletChart"   
    ' Sample data (values to display as bullets)
    ws.Cells(1, 1).Value = "Name"
    ws.Cells(1, 2).Value = "Value"   
    ws.Cells(2, 1).Value = "Item 1"
    ws.Cells(2, 2).Value = 7
    ws.Cells(3, 1).Value = "Item 2"
    ws.Cells(3, 2).Value = 5
    ws.Cells(4, 1).Value = "Item 3"
    ws.Cells(4, 2).Value = 9
    ws.Cells(5, 1).Value = "Item 4"
    ws.Cells(5, 2).Value = 6   
    ' Set the data range
    Set dataRange = ws.Range("A2:B5")   
    ' Find the maximum value in the "Value" column
    maxValue = Application.WorksheetFunction.Max(ws.Range("B2:B5"))   
    ' Set the width of the bullet bars and maximum length
    bulletWidth = 5 ' Initial width of the bullet
    maxLength = 200 ' Maximum width of the bars  
    ' Create the bullet chart (insert rectangle shapes for each row)
    For i = 2 To dataRange.Rows.Count
        ' Add a rectangle shape for each item
        Set rect = ws.Shapes.AddShape(msoShapeRectangle, 100, 20 * i, 0, 10)       
        ' Set the width of the rectangle based on the value
        rect.Width = (ws.Cells(i, 2).Value / maxValue) * maxLength       
        ' Format the bullet (color, border, etc.)
        rect.Fill.ForeColor.RGB = RGB(0, 0, 255) ' Blue color
        rect.Line.Visible = msoFalse ' No border
        rect.LockAspectRatio = msoFalse ' Unlock aspect ratio of the shape
    Next i  
    ' Adjust columns and rows for better visualization
    ws.Columns("A:B").AutoFit
    ws.Rows("1:1").RowHeight = 20
End Sub

Explanation of the Code:

Create a New Worksheet: A new worksheet is created to host the bullet chart.

Set ws = ThisWorkbook.Sheets.Add
ws.Name = "BulletChart"

Insert Data: We add some sample data (names and values) to the worksheet. These values will be represented as bullet bars.

ws.Cells(1, 1).Value = "Name"
ws.Cells(1, 2).Value = "Value"
ws.Cells(2, 1).Value = "Item 1"
ws.Cells(2, 2).Value = 7

Find Maximum Value: We calculate the maximum value from the « Value » column. This will be used to scale the width of the bullet bars.

maxValue = Application.WorksheetFunction.Max(ws.Range("B2:B5"))

Create Bullet Bars (Rectangle Shapes): For each value in the « Value » column, a rectangle shape is added to represent a bullet. The width of the rectangle is proportional to the value compared to the maximum value.

Set rect = ws.Shapes.AddShape(msoShapeRectangle, 100, 20 * i, 0, 10)
rect.Width = (ws.Cells(i, 2).Value / maxValue) * maxLength

Format the Bullet Bars: Each rectangle is formatted by setting a color (blue) and removing the border for a clean look. The aspect ratio of the rectangle is unlocked to allow for free resizing.

rect.Fill.ForeColor.RGB = RGB(0, 0, 255) ' Blue color
rect.Line.Visible = msoFalse ' No border

Adjust Columns and Rows: Finally, we autofit the columns and adjust the row height to make the chart more readable.

ws.Columns("A:B").AutoFit
ws.Rows("1:1").RowHeight = 20

Result:

This code will create a bullet chart on a new worksheet, where each row represents an item, and the width of the bullet (represented by a rectangle) is proportional to the value in the « Value » column.

0 0 votes
Évaluation de l'article
S’abonner
Notification pour
guest
0 Commentaires
Le plus ancien
Le plus récent Le plus populaire
Online comments
Show all comments
Facebook
Twitter
LinkedIn
WhatsApp
Email
Print
0
We’d love to hear your thoughts — please leave a commentx