I am creating a chart, in a form, using VBA Excel 2010. I have configured excel to use Chartspace and the chart is created using dynamic data correctly, but the presentation is not what I am looking for, but can't figure how to change it. Please see the section of code:
Private Sub UserForm_Initialize()
Dim row_count As Integer
Dim n As Long
Dim chart_data As Worksheet
Set chart_data = Worksheets("Sheet3")
row_count = chart_data.UsedRange.Rows.Count
Dim varCats()
Dim varVals()
ReDim varCats(row_count)
ReDim varVals(row_count)
'Set c = ChartSpace1.Constants
Set mychart = ChartSpace1.Charts.Add
mychart.Type = xlColumnClustered '51 'chChartTypeBarClustered 'c.chChartTypeBarClustered
For n = 2 To row_count
varCats(n) = ActiveWorkbook.Sheets("Sheet3").Range("A" & n).Value
varVals(n) = ActiveWorkbook.Sheets("Sheet3").Range("T" & n).Value
Next n
mychart.SeriesCollection.Add
With mychart.SeriesCollection(0)
.SetData chDimSeriesNames, chDataLiteral, "QAR Score"
.SetData chDimCategories, chDataLiteral, varCats
.SetData chDimValues, chDataLiteral, varVals
End With
End Sub
The bar chart is showing the bars horizontally and not vertically. So where I thought my variable "varCats" would go to the X-Axis is not but rather the Y-axis.
I know this is going to be a simple response from the community, but I have yet to find it through my searching.
Thanks,
C
Image from the answer provide:
Desired Results:
Revised to work with ChartSpace objects in UserForm
Private Sub UserForm_Initialize()
Dim row_count As Integer
Dim n As Long
Dim chart_data As Worksheet
Dim srs As ChSeries
Dim myChart As ChChart
Set chart_data = Worksheets("Sheet3")
row_count = chart_data.UsedRange.Rows.Count
ReDim varCats(1 To row_count)
ReDim varVals(1 To row_count)
varCats = Application.Transpose(chart_data.Range("A2:A" & row_count).Value)
varVals = Application.Transpose(chart_data.Range("T2:B" & row_count).Value)
'Set c = ChartSpace1.Constants
Set myChart = ChartSpace1.Charts.Add
myChart.Type = chChartTypeColumnClustered
Set srs = myChart.SeriesCollection.Add
With srs
.SetData chDimSeriesNames, chDataLiteral, "QAR Score"
.SetData chDimCategories, chDataLiteral, varCats
.SetData chDimValues, chDataLiteral, varVals
End With
End Sub
Related
I'm trying to create a dynamic Scatterchart in the worksheet("Graphs") using a button.
The Seriesname has to be equal to Worksheets("VS_P240_X").Cells(1,i), where i is a counter for the columns.
The XValues have to be equal to Worksheets("VS_P240_X").Range(cells(3,i).cells(1000,i)).
The YValues have to be equal to Worksheets("VS_P240_Y").Range(cells(3,i).cells(1000,i)).
When I Update the workbook the counter i will change, and I want that the chart will automatically update with the new series. I wrote this code but it is not working, do you have some suggestions?
Private Sub CommandButton5_Click()
'Graph generation NON COMPLETO
Dim i As Integer
Dim Chart1 As Chart
Set Chart1 = Sheets("Graphs").ChartObjects("Chart 1").Chart
For i = 1 To Lastcolumn
With Chart1
.ChartType = xlXYScatter
.SeriesCollection.NewSeries
'Change to what your series should be called
.SeriesCollection(i).Name = Worksheets("VS_P240_X").Cells(1, i).Value
.SeriesCollection(i).XValues = Worksheets("VS_P240_X").Range(Cells(3, i), Cells(1000, i))
.SeriesCollection(i).Values = Worksheets("VS_P240_Y").Range(Cells(3, i), Cells(1000, i))
End With
Next i
End Sub
To avoid confusion/bugs, it's best to specify a worksheet every time you use Range or Cells()
Something like this should work:
Private Sub CommandButton5_Click()
Dim i As Long, Lastcolumn As Long 'use long not integer
Dim Chart1 As Chart, wsX As Worksheet, wsY As Worksheet
Set wsX = Worksheets("VS_P240_X")
Set wsY = Worksheets("VS_P240_Y")
Set Chart1 = Sheets("Graphs").ChartObjects("Chart 1").Chart
Do While Chart1.SeriesCollection.Count > 0 'remove any existing data
Chart1.SeriesCollection(1).Delete
Loop
Chart1.ChartType = xlXYScatter 'do this outside of the loop...
Lastcolumn = wsX.Cells(1, wsX.Columns.Count).End(xlToLeft).Column
For i = 1 To Lastcolumn
With Chart1.SeriesCollection.NewSeries
.Name = wsX.Cells(1, i).Value
.XValues = wsX.Range(wsX.Cells(3, i), wsX.Cells(1000, i))
.Values = wsY.Range(wsY.Cells(3, i), wsY.Cells(1000, i))
End With
Next i
End Sub
I created a macro to plot graphs when the workbook is opened.
Sub create_graphs()
Dim wsInput As Worksheet, wsOutput As Worksheet
Dim LRowO As Long, LRowI As Long
Dim LColO As Long, LColI As Long
Dim Count As Integer
Dim LastChartRow As Integer
Set wsOutput = ThisWorkbook.Sheets("Summary")
With wsOutput
LRowI = .Range("A" & .Rows.Count).End(xlUp).Row
LColI = .Cells(1, .Columns.Count).End(xlToLeft).Column
LastChartRow = LRowI + 3
For Count = 2 To LRowI
.Shapes.AddChart2(201, xlColumnClustered).Select
ActiveChart.PlotBy = xlRows
ActiveChart.SetSourceData Source:=Range(.Cells(Count, 1), .Cells(Count,LColI))
ActiveChart.SeriesCollection(1).XValues = Range(.Cells(1, 2), .Cells(1,LColI))
ActiveChart.SetElement (msoElementDataLabelOutSideEnd)
ActiveChart.ChartTitle.Text = .Cells(Count, 1).Value
ActiveChart.Parent.Left = .Cells(LRowI + 5, 2).Left
ActiveChart.Parent.Top = .Cells(LastChartRow, 2).Top
LastChartRow = LastChartRow + 15
Next Count
End With
End Sub
Private Sub Workbook_Open()
Call create_graphs
End Sub
When I open the Excel workbook, it throws error message Object variable or With block variable not set and the graphs are not plotted. Checking from VB guide seems like it's variable issue. Please help to point out the mistake.
Is your sub on the workbook page in the visual editor? If not it needs to be on the same page or in a module vba will not call a sub from a different page.
I have items that are being populated on a worksheet via userform. When I open the workbook I'm trying to get the tool to go to the sheet grab the data and generate a chart/dashboard on the main landing sheet.
In the range of data contains statuses. I want VBA to look through one column of data and create a chart that counts each different status and put that in a bar chart.
yaxis = the different statuses
xaxis = count
my code so far
Sub populatecharts()
Dim ws As Worksheet
Dim ch As Chart
Dim tablerng As Range
Dim rng1 As Range
Dim rng2 As Range
Dim rng3 As Range
Dim sh As String
Set ws = ActiveSheet
'When the workbook opens it should always check the data and populate the BA Dashboard
'I need to check for sheets and if they exist generate a chart from the data
sh = "Action"
On Error Resume Next
Worksheets("Action").Visible = True
If CheckSheetExist(sh) = False Then
GoTo nextchart1
Else
Worksheets(sh).Activate
'Set ws = ActiveSheet
Set rng1 = Range("G4", Range("G4", "G4").End(xlDown))
rng1.Select
'Set rng2 = Range("B2")
'Set rng3 = Range("C3")
'Set tablerng = rng1 '& rng2 & rng3
Set ch = ws.Shapes.AddChart2(Width:=200, Height:=200, Left:=Range("B4").Left, Top:=Range("B4").Top).chart
With ch
.SetSourceData Source:=rng1
.ChartType = xlBarClustered
.ChartTitle.Text = "Action Items by Status"
End With
ws.Activate
Worksheets("Action").Visible = False
End If
Seems easy but I'm not able to think through it, also the location is hit or miss even though I define the top and bottom and size. Sometimes it's to the right of the cell I chose to be the left.
Try the next way, please. It uses a dictionary to extract the unique values and their count and array to feed the necessary series. Try running it on active sheet and adapt it to your situation only after having the confirmation that what it returns is what you need:
Sub populatecharts()
Dim shT As Worksheet, ch As Chart, lastRow As Long
Dim arrY, arrX, i As Long, dict As Object
Set shT = ActiveSheet 'use here the sheet you need
lastRow = shT.Range("G" & shT.Rows.count).End(xlUp).row
arrX = shT.Range("G4:G" & lastRow).Value 'put the range in a array
Set dict = CreateObject("Scripting.Dictionary") 'needed for the next step
On Error Resume Next
shT.ChartObjects("MyChartXY").Delete 'for the case of re running need
On Error GoTo 0
For i = 1 To UBound(arrX)
If Not dict.Exists(arrX(i, 1)) Then
dict(arrX(i, 1)) = 1 'create the unique keys
Else
dict(arrX(i, 1)) = dict(arrX(i, 1)) + 1 'increment the key next occurrrence
End If
Next i
arrX = dict.Keys: arrY = dict.Items 'extract the necessary arrays
Set ch = shT.ChartObjects.Add(left:=shT.Range("B4").left, _
top:=shT.Range("B4").top, width:=200, height:=200).Chart
With ch
.ChartType = xlBarClustered
.HasTitle = True
.ChartTitle.Text = "Action Items by Status"
.SeriesCollection.NewSeries.Values = arrY 'feed it with the array elements
.SeriesCollection(1).XValues = arrX 'feed it with the array elements
End With
End Sub
Please, test it and send some feedback.
Currently, all my charts are cramped together in the same spot in the same worksheet after running my code. So to view them i have to manually drag and move them to another spot. So is there a way such that i can place all the charts in a orderly manner as shown in expected output? If it is really impossible to do something like this, i am ok with offsetting the graph for every 20 cells even though it is abit inconvenient for viewing but still i attempted to do it but fail to make it happen when i include code with current output with the offsetting code.
Current output(looks like there is 1 chart but all the charts are in the same spot)
Below is the code for my current output
Sub plotgraphs()
'Call meangraph
Call sigmagraph
End Sub
Private Sub sigmagraph()
Dim i As Long, c As Long
Dim shp As Shape
Dim Cht As chart, co As Shape
Dim rngDB As Range, rngX As Range, rngY As Range
Dim Srs As Series
Dim ws As Worksheet
Set ws = Sheets("Data")
Set rngDB = ws.Range("A1").CurrentRegion
Set rngX = rngDB.Columns(1)
Set rngY = rngDB.Columns(4)
Do While Application.CountA(rngY) > 0
Set co = Worksheets("meangraphs").Shapes.AddChart
Set Cht = co.chart
With Cht
.ChartType = xlXYScatter
'remove any data which might have been
' picked up when adding the chart
Do While .SeriesCollection.Count > 0
.SeriesCollection(1).Delete
Loop
'add the data
With .SeriesCollection.NewSeries()
.XValues = rngX.Value
.Values = rngY.Value
End With
'formatting...
With Cht.Axes(xlValue)
.MinimumScale = 0
.MaximumScale = 0.5
.TickLabels.NumberFormat = "0.00E+00"
End With
Cht.Axes(xlCategory, xlPrimary).HasTitle = True
Cht.Axes(xlValue, xlPrimary).HasTitle = True
End With
Set rngY = rngY.Offset(0, 2) 'next y values
Loop
Code for offsetting chart for every 20 cells (fail to make it happen)
Dim OutSht As Worksheet
'
Dim PlaceInRange As Range
Set OutSht = ActiveWorkbook.Sheets("sigmagraphs") '<~~ Output sheet
Set PlaceInRange = OutSht.Range("B2:J21") '<~~ Output location
'
' To place charts at a distance between them
For Each chart In Sheets("sigmagraphs").ChartObjects
' OutSht.Paste PlaceInRange
' Code below changes the range itself to something 20 rows below
Set PlaceInRange = PlaceInRange.Offset(20, 0)
Next chart
Expected output
What you are looking for is the .Left and .Top properties of the Shape containing the Chart.
For example, a macro that would setup your charts into a 2-column grid would look like this:
Sub SetupChartsIntoGrid()
Const TopAnchor As Long = 50
Const LeftAnchor As Long = 50
Const HorizontalSpacing As Long = 10
Const VerticalSpacing As Long = 10
Const ChartHeight As Long = 211
Const ChartWidth As Long = 360
Dim shp As Shape
For Each shp In ActiveSheet.Shapes
If shp.Type = msoChart Then
Dim Counter As Long
Counter = Counter + 1
With shp
.Top = TopAnchor + (WorksheetFunction.RoundUp(Counter / 2, 0) - 1) * (VerticalSpacing + ChartHeight)
.Left = LeftAnchor + ((Counter + 1) Mod 2) * (HorizontalSpacing + ChartWidth)
End With
End If
Next
End Sub
I'm trying to colour my pie chart segments, according to the cells the data is drawn from, using Excel 2016.
I pinched code from a YouTube video but this is hard to read in places (1, l & i are particularly hard to differentiate) so I'm not convinced I have it right.
Private Sub SheetActivate(ByVal Sh As Object)
Dim cht As ChartObject
Dim i As Integer
Dim vntValues As Variant
Dim s As String
Dim mySeries As Series
For Each cht In ActiveSheet.ChartObjects
For Each mySeries In cht.Chart.SeriesCollection
If mySeries.ChartType <> xlPie Then GoTo SkipNotPie
s = Split(mySeries.Formula, ",")(2)
vntValues = mySeries.Values
For i = 1 To UBound(vntValues)
mySeries.Points(i).Interior.Color = Range(s).Cells(i).Interior.Color
Next l
SkipNotPie:
Next mySeries
Next cht
End Sub
Update: here is a snip showing the charts - I'm trying to update the chart segments to represent the cell fill colours in the second column.
With minor adjustments, this worked fine:
Private Sub SheetActivate()
Dim cht As ChartObject
Dim i As Long
Dim vntValues As Variant
Dim s As String
Dim mySeries As Series
For Each cht In ActiveSheet.ChartObjects
For Each mySeries In cht.Chart.SeriesCollection
If mySeries.ChartType <> xlPie Then GoTo SkipNotPie
s = Split(mySeries.Formula, ",")(2)
vntValues = mySeries.Values
For i = 1 To UBound(vntValues)
mySeries.Points(i).Interior.Color = Range(s).Cells(i).Interior.Color
Next i
SkipNotPie:
Next mySeries
Next cht
End Sub
Make sure you don't have Option Base 1 at the top of the module. If you do, then change
s = Split(mySeries.Formula, ",")(2)
to
s = Split(mySeries.Formula, ",")(3)
I haven't used Option Base 1 since I learned to count starting at zero.