StackOverflow2013

Note that there are some explanatory texts on larger screens.

plurals

PO
text
Body
copied!<p>Here's some code from Excel 2010 that may work. It has a couple specifics (like filtering bad-encode characters from titles) but it was designed to create multiple multi-series graphs from 4-dimensional data having both absolute and percentage-based data. Modify it how you like:</p> <pre><code>Sub createAllGraphs() Const chartWidth As Integer = 260 Const chartHeight As Integer = 200 If Sheets.Count = 1 Then Sheets.Add , Sheets(1) Sheets(2).Name = "AllCharts" ElseIf Sheets("AllCharts").ChartObjects.Count > 0 Then Sheets("AllCharts").ChartObjects.Delete End If Dim c As Variant Dim c2 As Variant Dim cs As Object Set cs = Sheets("AllCharts") Dim s As Object Set s = Sheets(1) Dim i As Integer Dim chartX As Integer Dim chartY As Integer Dim r As Integer r = 2 Dim curA As String curA = s.Range("A" & r) Dim curB As String Dim curC As String Dim startR As Integer startR = 2 Dim lastTime As Boolean lastTime = False Do While s.Range("A" & r) <> "" If curC <> s.Range("C" & r) Then If r <> 2 Then seriesAdd: c.SeriesCollection.Add s.Range("D" & startR & ":E" & (r - 1)), , False, True c.SeriesCollection(c.SeriesCollection.Count).Name = Replace(s.Range("C" & startR), "Â", "") c.SeriesCollection(c.SeriesCollection.Count).XValues = "='" & s.Name & "'!$D$" & startR & ":$D$" & (r - 1) c.SeriesCollection(c.SeriesCollection.Count).Values = "='" & s.Name & "'!$E$" & startR & ":$E$" & (r - 1) c.SeriesCollection(c.SeriesCollection.Count).HasErrorBars = True c.SeriesCollection(c.SeriesCollection.Count).ErrorBars.Select c.SeriesCollection(c.SeriesCollection.Count).ErrorBar Direction:=xlY, Include:=xlBoth, Type:=xlCustom, Amount:="='" & s.Name & "'!$F$" & startR & ":$F$" & (r - 1), minusvalues:="='" & s.Name & "'!$F$" & startR & ":$F$" & (r - 1) c.SeriesCollection(c.SeriesCollection.Count).ErrorBar Direction:=xlX, Include:=xlBoth, Type:=xlFixedValue, Amount:=0 c2.SeriesCollection.Add s.Range("D" & startR & ":D" & (r - 1) & ",G" & startR & ":G" & (r - 1)), , False, True c2.SeriesCollection(c2.SeriesCollection.Count).Name = Replace(s.Range("C" & startR), "Â", "") c2.SeriesCollection(c2.SeriesCollection.Count).XValues = "='" & s.Name & "'!$D$" & startR & ":$D$" & (r - 1) c2.SeriesCollection(c2.SeriesCollection.Count).Values = "='" & s.Name & "'!$G$" & startR & ":$G$" & (r - 1) c2.SeriesCollection(c2.SeriesCollection.Count).HasErrorBars = True c2.SeriesCollection(c2.SeriesCollection.Count).ErrorBars.Select c2.SeriesCollection(c2.SeriesCollection.Count).ErrorBar Direction:=xlY, Include:=xlBoth, Type:=xlCustom, Amount:="='" & s.Name & "'!$H$" & startR & ":$H$" & (r - 1), minusvalues:="='" & s.Name & "'!$H$" & startR & ":$H$" & (r - 1) c2.SeriesCollection(c2.SeriesCollection.Count).ErrorBar Direction:=xlX, Include:=xlBoth, Type:=xlFixedValue, Amount:=0 If lastTime = True Then GoTo postLoop End If If curB <> s.Range("B" & r).Value Then If curA <> s.Range("A" & r).Value Then chartX = chartX + chartWidth * 2 chartY = 0 curA = s.Range("A" & r) End If Set c = cs.ChartObjects.Add(chartX, chartY, chartWidth, chartHeight) Set c = c.Chart c.ChartWizard , xlXYScatterSmooth, , , , , True, Replace(s.Range("B" & r), "Â", "") & " " & s.Range("A" & r), s.Range("D1"), s.Range("E1") Set c2 = cs.ChartObjects.Add(chartX + chartWidth, chartY, chartWidth, chartHeight) Set c2 = c2.Chart c2.ChartWizard , xlXYScatterSmooth, , , , , True, Replace(s.Range("B" & r), "Â", "") & " " & s.Range("A" & r) & " (%)", s.Range("D1"), s.Range("G1") chartY = chartY + chartHeight curB = s.Range("B" & r) curC = s.Range("C" & r) End If curC = s.Range("C" & r) startR = r End If If s.Range("A" & r) <> "" Then oneMoreTime = False ' end the loop for real this time r = r + 1 Loop lastTime = True GoTo seriesAdd postLoop: cs.Activate End Sub </code></pre>

Querying!

Guidance

An individual column

Larger individual text columns get their own page to allow for proper reading.

SQuiL has stopped working due to an internal error.

If you are curious you may find further information in the browser console, which is accessible through the devtools (F12).

Reload