I have a list of data and I need to generate a chart for every two lines and give a chart title associated to the 1st line. Example of the data is:
Example
And so on.
The code I am using to create the charts is:
Sub loopChart()
Dim mychart As Chart
Dim myRange As Range
Dim c As Integer
Dim r As Integer
Dim s As Integer
Dim ttl As String
r = 2
While r <= 10 '1=dataSource1, 4=dataSource2, 7=dataSource3
'set data source for the next chart
With Worksheets("Sheet9")
Set myRange = .Range(.Cells(r, 2), .Cells(r + 1, 14))
End With
'create chart
Sheets("Chart").Select
ActiveSheet.Shapes.AddChart.Select
With ActiveChart
ttl = Range("A" & r)
.ChartType = xlLineMarkers 'xlLine
.SetSourceData Source:=myRange, PlotBy:=xlRows 'sets source data for graph including labels
.SetElement (msoElementLegendRight) 'including legend
.HasTitle = True
'dimentions & location:
.Parent.Top = 244 'defines the coordinates of the top of the chart
'.Parent.Left = r * 150 'defines the coordinates for the left side of the chart
.Parent.Height = 200
.Parent.Width = 300
.ChartTitle.Formula = ttl
End With
r = r + 2
Wend
End Sub
So, the 1st chart that generates should get the title on row 2, next chart should have title of row 4...
I always get the Chart title on 1st chart that generates but not on any of the other charts. Can anyone please help me on this?
Please fix below.
ttl = Range("A" & r)
to
ttl = Worksheets("Sheet9").Range("A" & r).Value
I think #Dy.Lee answer will do the trick but to go a bit further :
Try avoiding using .select
Proposed workaround :
Sub loopChart()
Dim Ch As Chart
Dim Sh1 As Worksheet: Set Sh1 = Sheets("Sheet9")
Dim Sh2 As Worksheet: Set Sh2 = Sheets("Chart")
Dim L As Integer
L = 0
For i = 2 To 18 Step 2
Set Ch = Sh2.Shapes.AddChart.Chart
Ch.SetSourceData Sh1.Range(Sh1.Cells(i, 2), Sh1.Cells(i + 1, 14))
Ch.ChartType = xlLineMarkers
Ch.SetElement (msoElementLegendRight)
Ch.HasTitle = True
Ch.Parent.Top = 244
Ch.Parent.Height = 200
Ch.Parent.Width = 300
Ch.Parent.Left = L
Ch.ChartTitle.Caption = Sh1.Cells(i, 1).Value
L = L + 300
Next i
End Sub
Your code will create each graph at the same location so you'll see only one (the last one) hence the Ch.Parent.Left line with variable value.
Related
Name Progress
Student1 93
Student2 80
Student3 51
Student4 91
Student5 65
Student6 45
student7 33
I am still new to VBA programming. Above is my data set example and below is my code which is able to populate columns C to E to the right without giving any error. Below is my chart code which gives me a bad chart when I run it. Please advise on how to go about plotting these populated values on columns C to E on a bar chart on the same worksheet, where a green bar shows progress >= 90, amber bar shows 50 <= Progress And Progress < 90 and red bar shows progress <50.
Sub ClassCategories()
Dim startRow As Long, lastRow As Long, n As Integer
startRow = 2
n = 8
Dim i As Long, Progress As Long
Dim sClass1 As String
Dim sClass2 As String
Dim sClass3 As String
For i = startRow To n
Progress = ThisWorkbook.Worksheets("sheet1").Range("B" & i).Value
' Check progress and classify accordingly
If Progress >= 90 Then
sClass3 = Progress
Else
sClass3 = " "
End If
If 50 <= Progress And Progress < 90 Then
sClass2 = Progress
Else
sClass2 = " "
End If
If Progress < 50 Then
sClass1 = Progress
Else
sClass1 = " "
End If
' Write out the class to column C to E
Worksheets("sheet1").Range("C" & i).Value = sClass1
Worksheets("sheet1").Range("D" & i).Value = sClass2
Worksheets("sheet1").Range("E" & i).Value = sClass3
Next
End Sub
Private Sub Createachart()
Dim oChObj As ChartObject, rngSourceData As Range, ws As Worksheet
Set ws = Sheets("Sheet1")
Set rngSourceData = ws.Range("C3:E8")
Set oChObj = ws.ChartObjects.Add(Left:=ws.Columns("A").Left,
Width:=290, Top:=ws.Rows(8).Top, Height:=190)
With oChObj.Chart
.ChartType = xlColumnClustered
.SetSourceData Source:=rngSourceData, PlotBy:=xlColumns
.Axes(xlCategory).CategoryNames = ws.Range("A2:A8")
.HasTitle = True
End With
End Sub
I guess this code is what you need (providing your example table starts in A1 cell):
Sub CreateChart()
Dim sh As Shape
Dim ch As Chart
Dim ser As Series
Dim lColor&, i%, x, arr
'// Remove all charts
For Each sh In ActiveSheet.Shapes
If sh.Type = msoChart Then sh.Delete
Next
'// Add chart to sheet
With Range("A10:N30")
Set ch = .Parent.Shapes.AddChart(xlColumn, .Left, .Top, .Width, .Height).Chart
End With
With ch
'// If user's selection is within chart data range,
'// then Excel will create chart based on data in this range.
'// We don't need it, so clear the chart out.
.ChartArea.ClearContents
'// Add series
Set ser = ch.SeriesCollection.NewSeries()
ser.Values = Range("B2:B8").Value
ser.XValues = Range("A2:A8").Value
'// Get values
arr = ser.Values
'// Format points based on values
For i = 1 To UBound(arr)
x = arr(i)
Select Case True
Case x >= 90: lColor = vbGreen
Case x >= 50 And x < 90: lColor = vbYellow
Case x < 50: lColor = vbRed
End Select
ser.Points(i).Format.Fill.ForeColor.RGB = lColor
Next
End With
End Sub
You can download workbook with code here.
Result:
I want to create 40 different column stacked graphs using macros in Excel. Each graph has two series. So far I've done this:
Sub loopChart()
Dim mychart As Chart
Dim myRange As Range
Dim c As Integer
Dim d As Integer
c = 1
d = 2
While c <= 33 '1=dataSource1, 4=dataSource2, 7=dataSource3
While d <= 33
'set data source for the next chart
With Worksheets("Hoja1")
Set myRange = .Range(.Cells(1, c), .Cells(3, c + 1))
Set myRange2 = .Range(.Cells(1, d), .Cells(3, d + 1))
End With
'create chart
Sheets("Hoja1").Select
ActiveSheet.Shapes.AddChart.Select
With ActiveChart
.ChartType = xl3DColumnStacked
'sets source data for graph including labels
.SetSourceData Source:=myRange2, PlotBy:=xlColumns
'including legend
.SetElement (msoElementLegendRight)
.HasTitle = True
'dimentions & location:
'defines the coordinates of the top of the chart
.Parent.Top = 244
'defines the coordinates for the left side of the chart
.Parent.Left = c * 100
.Parent.Height = 200
.Parent.Width = 300
.ChartTitle.Text = "Porcenta-2014"
End With
c = c + 3
d = d + 3
Wend
Wend
End Sub
I want that insted of 1 and 2 my graphs use de name of the column A:
Sub tset()
Dim dataRange As Range
Dim dataNames As Range
Dim c As Integer
Set dataRange = Range("B1:C3")
Set dataNames = Range("A2:A3")
c = 1
For i = 1 To 40
ActiveSheet.Shapes.AddChart.Select
With ActiveChart
.SetSourceData Source:=dataRange, PlotBy:=xlColumns
.SeriesCollection(1).XValues = dataNames
.ChartType = xl3DColumnStacked
.SetElement (msoElementLegendRight)
.HasTitle = True
.Parent.Top = 244
.Parent.Left = c * 100
.Parent.Height = 200
.Parent.Width = 300
.ChartTitle.Text = "Porcenta-2014"
End With
c = c + 3
Set dataRange = dataRange.Offset(0, 2)
Next i
End Sub
I'm noob in vba (Excel macros). I need to add somes charts automatically in the same WorkSheet. This is my code:
Sub runChart()
Dim xchart As Chart
Dim nameSheet As String
nameSheet = ActiveSheet.Name
Dim x As Integer
Dim firstIndex As Integer
Dim firstValue As Integer
Dim actualValue As Integer
Dim actualIndex As Integer
Dim rChart1 As Range
Dim rChart2 As Range
MsgBox nameSheet
firstIndex = 2
actualIndex = 2
firstValue = Cells(2, 1)
actualValue = Cells(2, 1)
Do
Do
actualIndex = actualIndex + 1
actualValue = Sheets(nameSheet).Cells(actualIndex, 1)
Loop Until firstValue <> actualValue
Set rChart1 = Range(Sheets(nameSheet).Cells(firstIndex, "E"), Sheets(nameSheet).Cells(actualIndex - 1, "E"))
Set rChart1 = Union(rChart1, Range(Sheets(nameSheet).Cells(firstIndex, "J"), Sheets(nameSheet).Cells(actualIndex - 1, "J")))
Dim nameChart As String
nameChart = CStr(Sheets(nameSheet).Cells(firstIndex, 5)) & " - " & Sheets(nameSheet).Cells(actualIndex, 5) & " " & CStr(Sheets(nameSheet).Cells(firstIndex, 1))
Set xchart = Charts.Add
With xchart
.Name = nameChart
.ChartType = xlColumnClustered
.SetSourceData rChart1
.Location Where:=xlLocationAsObject, Name:=nameSheet
'position and size chart
.ChartArea.Top = 10 'this position is a example
.ChartArea.Left = 1700 'this position is a example
.ChartArea.Height = 400 'this size is a example
.ChartArea.Width = 750 'this size is a example
End With
firstValue = Sheets(nameSheet).Cells(actualIndex, 1)
firstIndex = actualIndex
Loop Until (Sheets(nameSheet).Cells(actualIndex, 1) = vbNullString)
End Sub
So, my problem happens is in .ChartArea.left = 1700. The program says :
The specified dimension is not valid for the current chart type
anyone has any idea what 's happening? Thanks for your time :)
The ChartArea is the overall rectangle containing the chart within its parent ChartObject (the shape that contains the embedded chart). The position and size of the ChartArea are read only. But that's okay, you want to position and resize the ChartObject, which is the chart's .Parent.
With xchart
'position and size chart
.Parent.Top = 10 'this position is a example
.Parent.Left = 1700 'this position is a example
.Parent.Height = 400 'this size is a example
.Parent.Width = 750 'this size is a example
End With
I'm trying to make add two series to a single XYscatter chart via loop. Currently, my code creates two charts. The X values are constant but the Y values change so I added them to an array to preserve them.
Sub test()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Sheet1")
Dim thearray(9) As Double
Dim chrt As Chart
Dim n As Integer, i As Integer, q As Integer
For q = 1 To 2
For i = 0 To 9
thearray(i) = WorksheetFunction.RandBetween(1, 20)
Next
Set chrt = sh.Shapes.AddChart.Chart
With chrt
.ChartType = xlXYScatterLines
.SeriesCollection.NewSeries
.SeriesCollection(1).Name = "TEST"
.SeriesCollection(1).XValues = Range("B2:K2")
.SeriesCollection(1).Values = thearray
.SeriesCollection(1).MarkerSize = 4
For n = .SeriesCollection.Count To 2 Step -1
.SeriesCollection(n).Delete
Next n
End With
Next
End Sub
I appreciate any help offered.
Edit: I tried changing
.SeriesCollection(1)
To
.SeriesCollection(q)
But it doesn't work.
EDIT2: I figured it out. I took
Set chrt = sh.Shapes.AddChart.Chart
Out of the loop and replaced 1 with q in .SeriesCollection
The code that works.
Sub test()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Sheet1")
Dim thearray(9) As Double
Dim chrt As Chart
Dim n As Integer, i As Integer, q As Integer
Set chrt = sh.Shapes.AddChart.Chart
For q = 1 To 2
For i = 0 To 9
thearray(i) = WorksheetFunction.RandBetween(1, 20)
Next
With chrt
.ChartType = xlXYScatterLines
.SeriesCollection.NewSeries
.SeriesCollection(q).Name = "HFF " & q
.SeriesCollection(q).XValues = Range("B2:K2")
.SeriesCollection(q).Values = thearray
.SeriesCollection(q).MarkerSize = 4
For n = .SeriesCollection.Count To 3 Step -1
.SeriesCollection(n).Delete
Next n
End With
Next
End Sub
Please see the code below:
Sub CreatePieCharts()
'Declare the variables
Dim wks As Worksheet
Dim AddtionalCharts As Chart
Dim MySeries As Series
Dim Rng As Range
Dim CatRange As Range
Dim SourceRange As Range
Dim SourceData As Range
Dim LeftPos As Double
Dim TopPos As Double
Dim Gap As Integer
Dim i As Long
Dim j As Long
Dim k As Long
'Set the range for the source data from the active worksheet
Set Rng = Range("A1").CurrentRegion
'Set the position of the first chart
LeftPos = Range("M3").Left
TopPos = Range("M3").Top
'Set the gap between charts
Gap = 5
'Set the range for the category values
For j = 1 To Rng.Columns.Count
For i = 2 To Rng.Columns.Count
If j Mod 2 = 1 And i Mod 2 = 0 Then _
Set SourceData = Union(Rng.Columns(j), Rng.Columns(i))
'Create the pie charts
Set AddtionalCharts = ActiveSheet.Shapes.AddChart.Chart
With AddtionalCharts
.SetSourceData SourceData, xlColumns
.ChartType = xlPie
.ApplyDataLabels xlDataLabelsShowValue, False
.Parent.Left = LeftPos
.Parent.Top = TopPos
TopPos = TopPos + .Parent.Height + Gap
End With
Next i
Next j
End Sub
Basically, the macro needs to loop through the columns and create charts based on the columns even or odd state. For example: Chart1 and Answer 1 should be one chart, Chart2 and Answer2 should be the next one and so on.
Right now I am able to create the charts but for some reason there are some other extra charts that show which I don't need. What am I doing wrong?
I think you just need to include the pie chart creation bit into your If construct. Right now it isn't, so a chart gets created no matter what.
What you're doing is this:
If <condition> Then <statement1>
<statement2>
Here, <statement2> will always be executed regardless of <condition>.
Do this instead:
If <condition> Then
<statement1>
<statement2>
'...
End If
In this case, <statement2> only gets executed (along with <statement1>) if <condition> is satisfied.
In your specific case:
If j Mod 2 = 1 And i Mod 2 = 0 Then
Set SourceData = Union(Rng.Columns(j), Rng.Columns(i))
'Create the pie charts
Set AddtionalCharts = ActiveSheet.Shapes.AddChart.Chart
With AddtionalCharts
.SetSourceData SourceData, xlColumns
.ChartType = xlPie
.ApplyDataLabels xlDataLabelsShowValue, False
.Parent.Left = LeftPos
.Parent.Top = TopPos
TopPos = TopPos + .Parent.Height + Gap
End With
End If