I am trying to change the location of the graph that I generate with my vba. For now, it is just taking data from a column that may or may not change size. I understand I do not have 'Chart1' identified ion my code but I can not figure out where to declare it where it doesn't create another sheet for the chart as well.
reportsheet.Select
ActiveSheet.Range("a4", ActiveSheet.Range("a4").End(xlDown)).Select
ActiveSheet.Shapes.AddChart.Select
With ActiveSheet.Shapes("Chart1")
.Left = Range("A40").Left
.Top = Range("A40").Top
End With
You can change Name of active Chart and then assign the properties to it.
Try This...
reportsheet.Select
ActiveSheet.Range("A4", ActiveSheet.Range("A4").End(xlDown)).Select
ActiveSheet.Shapes.AddChart.Select
ActiveChart.Parent.Name = "Chart1"
With ActiveSheet.Shapes("Chart1")
.Left = Range("A40").Left
.Top = Range("A40").Top
End With
I use make chart like this. Please refer to bellows.
Sub test()
Dim Ws As Worksheet
Set Ws = ActiveSheet
InsertCharts 20, Ws
InsertCharts 30, Sheets("Sheet1")
End Sub
Sub InsertCharts(n As Integer, Ws As Worksheet)
Dim Cht As Shape
Dim t As Single, w As Integer, h As Integer, x As Integer
Dim i As Integer
With Ws
If .ChartObjects.Count > 0 Then
.ChartObjects.Delete
End If
x = 0
t = .Range("a26").Top
w = 217.1338582677
h = 203.5275590551
For i = 1 To n
Set Cht = .Shapes.AddChart(, x, t, w, h)
If i Mod 5 = 0 Then
t = .Range("a26").Top
x = x + w + 20
Else
t = t + h + 20
End If
Next i
End With
End Sub
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 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.
I want to write a function where I can select one shape after which a macro aligns all the shapes that are within a 'short range' of the selected shape.
Therefore I wrote the following code that selects all the object within a range:
Sub Shape_Dimensions()
Dim L As Long
Dim T As Long
Dim H As Long
Dim W As Long
With ActiveWindow.Selection
If .Type = ppSelectionShapes Then
L = .ShapeRange.Left
T = .ShapeRange.Top
H = .ShapeRange.Height
W = .ShapeRange.Width
Else
MsgBox "You have not selected an OBJECT in PowerPoint to dimension."
Exit Sub
End If
End With
'Set range for selection
TopRange = L + 30
DownRange = T + H + 20
'Left and right are 0 - 600
End Sub
Now the final step I want to take is select all shapes that are within the top range and down range and align them with the top of the selected box. Any thoughts on how I should proceed?
Sub Shape_Align()
Dim L As Long
Dim T As Long
Dim H As Long, TopRange As Long, DownRange As Long
Dim W As Long, s As Shape, n As String
With ActiveWindow.Selection
If .Type = ppSelectionShapes Then
L = .ShapeRange.Left
T = .ShapeRange.Top
H = .ShapeRange.Height
W = .ShapeRange.Width
n = .ShapeRange.Name
Else
MsgBox "You have not selected an OBJECT in PowerPoint to dimension."
Exit Sub
End If
End With
'Set range for selection
TopRange = L + 30
DownRange = T + H + 20
'Left and right are 0 - 600
For Each s In ActiveWindow.View.Slide.Shapes
If s.Name <> n Then
'in scope for lining up?
If Abs(s.Top - T) < 60 Then
s.Top = T
End If
End If
Next s
End Sub
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