Paired Chart Automation Macro

F

Freitag

Board Regular
Joined
Jan 26, 2008
Messages
108
I need to design an Excel VBA macro to automate the creation of approximately 1,100 charts (paired by ID number for a total of ~ 550 pairs of bar charts).

My data is set up like this:

<TABLE style="WIDTH: 240pt; BORDER-COLLAPSE: collapse" border=0 cellSpacing=0 cellPadding=0 width=320><COLGROUP><COL style="WIDTH: 48pt" span=5 width=64><TBODY><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; WIDTH: 48pt; HEIGHT: 12.75pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl63 height=17 width=64>ID</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl63 width=64>City</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl63 width=64>State</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl63 width=64>City </TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl63 width=64>National</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 12.75pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl63 height=17 align=right>1112</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl63 align=right>55</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl63 align=right>58</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl63 align=right>55</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl63 align=right>62</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 12.75pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl63 height=17 align=right>1234</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl63 align=right>88</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl63 align=right>72</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl63 align=right>88</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl63 align=right>43</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 12.75pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl63 height=17 align=right>2157</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl63 align=right>98</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl63 align=right>85</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl63 align=right>98</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl63 align=right>96</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 12.75pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl63 height=17 align=right>3198</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl63 align=right>69</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl63 align=right>62</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl63 align=right>69</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl63 align=right>63</TD></TR></TBODY></TABLE>

So, for ID 1112, I will need the macro to generate 2 vertical bar charts (one for City/State (55 & 58 side-by-side) & a second one for City/National (55 & 62 side-by-side). My ultimate goal after this is to Automate moving the paired bar charts to a PPT slide.


I found some code on OzGrid, but it needs to be modified to accomplish what I need. Can anyone help me? I'm new to VBA & development. :confused:

The code from OzGrid is:

Function CreateBarCharts() As Boolean
Dim myChtObj As ChartObject
Dim rngChtData As Range
Dim rngChtXVal As Range
Dim iColumn As Long

Dim sheetName As String
sheetName = "DataSource"
Dim WSD As Worksheet
Set WSD = Worksheets(sheetName)

Dim chartSheet As String
chartSheet = "ChartOutput"
Dim CSD As Worksheet
Set CSD = Worksheets(chartSheet)

' get the current charts so proper overwriting can happen
Dim chtObjs As ChartObjects
Set chtObjs = CSD.ChartObjects
' Turn off autofilter mode
WSD.AutoFilterMode = False

' Find the last row with data
Dim finalRow As Long
finalRow = WSD.Cells(Application.Rows.Count, 1).End(xlUp).Row

Dim i As Integer

' for each row in the sheet
For i = 2 To finalRow

Dim chartName As String
chartName = WSD.Cells(i, 5).Value

' Delete chart if it already exists, we are making a new one
Dim chtObj As ChartObject
For Each chtObj In chtObjs
If chtObj.Name = chartName Then
chtObj.Delete
End If
Next

' define chart data range for the row (record)
Dim dataString As String
dataString = "C" & i & ":D" & i
Set rngChtData = WSD.Range(dataString)

' define the x values
Set rngChtXVal = WSD.Range("$C$1:$D$1")
' add the chart
Charts.Add
With ActiveChart

' make a bar chart
.ChartType = xlColumnClustered
' remove extra series
Do Until .SeriesCollection.Count = 0
.SeriesCollection(1).Delete
Loop

' add series from selected range, column by column
With .SeriesCollection.NewSeries
.Values = rngChtData
.XValues = rngChtXVal
.Name = "Cost"
End With

.Location Where:=xlLocationAsObject, Name:=chartSheet
End With
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "Benefits Cost"
.Parent.Name = WSD.Cells(i, 5).Value
.Legend.Delete

.Axes(xlCategory).TickLabels.AutoScaleFont = False
With .Axes(xlCategory).TickLabels.Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.Background = xlAutomatic
End With

.Axes(xlValue).TickLabels.AutoScaleFont = False
With .Axes(xlValue).TickLabels.Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.Background = xlAutomatic
End With

.ChartTitle.AutoScaleFont = False
With .ChartTitle.Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.Background = xlAutomatic
End With

With .PlotArea.Interior
.ColorIndex = 2
.PatternColorIndex = 1
.Pattern = xlSolid
End With

End With

' Set the height and width
With CSD.ChartObjects(chartName)
.Width = 225
.Height = 175
End With
Next i
End Function
 

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.
You must log in or register to reply here.

Similar threads

A
  • Question
VBA - Automatically Break the Line in HTML format.
Replies
7
Views
1K
Attrazion
A
Y
  • Question
Using Offset to select negative cell range using variables
Replies
1
Views
101
Yamezz
Y
G
  • Question
Using Excel formula to create HTML code text referencing specific cells
Replies
0
Views
864
gvsumich
G
R
  • Question
Macro not working after adding two new items
Replies
4
Views
165
myall_blues
myall_blues
E
  • Question
Adding a custom message.
Replies
1
Views
461
Micron
M

Forum statistics

Threads
1,216,073
Messages
6,128,644
Members
449,461
Latest member
kokoanutt

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