How do I place four chartobjects in a single Excel chartsheet with four ranges of data set?
I create all four charts in a chart sheet. I am struggling to resize the first chartobject since it looks like the chart size is fixed.
If I create a chart in a chart sheet, is it going to be the fixed size, fitting to the entire screen?
Also, I tried to select each chart using chart index, but the first chartobject doesn't have the index, resulting in getting only three index out of four chartobjects.
The code is not working since the second import chart will be index 1 which won't match to ForLoop index.
For i = 1 To cnt_dataset - 1
Range((Cells(data_array(i, 1), 21)), (Cells(data_array(i, 2), 22))).Select
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlLine
ActiveChart.ApplyLayout (10)
ActiveChart.ChartGroups(1).HiLoLines.Select
Selection.Delete
If i = 1 Then
ActiveChart.Location Where:=xlLocationAsNewSheet, Name:="Chart"
Else
ActiveChart.Location Where:=xlLocationAsObject, Name:="Chart"
ActiveSheet.ChartObjects(i).Activate
End If
With ActiveChart
.ChartTitle.Text = "Chart A"
.Axes(xlValue, xlPrimary).AxisTitle.Text = "y"
.Axes(xlCategory, xlPrimary).AxisTitle.Text = "x"
.Axes(xlCategory).Select
End With
Selection.TickLabels.NumberFormat = "#,##0"
ActiveWindow.WindowState = xlMaximized
Next i
Using this simple data...
...here is simple code to create a blank chart sheet, then make simple charts directly on this chart sheet.
Sub PutChartsIntoChartSheet()
Dim ws As Worksheet
Set ws = ActiveSheet
Dim rng As Range
Set rng = ActiveSheet.UsedRange
Dim cht As Chart
Set cht = ActiveWorkbook.Charts.Add
cht.ChartArea.Clear
Dim rX As Range
Set rX = rng.Columns(1)
Dim iCht As Long
For iCht = 1 To rng.Columns.Count - 1
Dim rY As Range
Set rY = rX.Offset(, iCht)
Dim cht2 As Chart
Set cht2 = cht.Shapes.AddChart(xlLine).Chart
cht2.SetSourceData Union(rX, rY)
Next
End Sub
I've made no attempts to embellish the charts or arrange them nicely on the chart sheet.
This should run without issues.
When you create a chart sheet, the chart you see is in the chart sheet, not in a container called a ChartObject. So you need a blank chart sheet, and you need to embed all of your charts as ChartObjects in this chart sheet.
Replace this bit:
If i = 1 Then
ActiveChart.Location Where:=xlLocationAsNewSheet, Name:="Chart"
Else
ActiveChart.Location Where:=xlLocationAsObject, Name:="Chart"
ActiveSheet.ChartObjects(i).Activate
End If
with this
' create reference to new chart
Dim cht As Chart
Set cht = ActiveChart
If i = 1 Then
' add chart sheet and make it blank
ActiveWorkbook.Charts.Add
ActiveChart.Name = "Chart"
ActiveChart.ChartArea.Clear
End If
cht.Location Where:=xlLocationAsObject, Name:="Chart"
ActiveSheet.ChartObjects(i).Activate
Related
I am very new to VBA and I am trying to create a chart with selected data from one sheet to create an entirely new sheet that displays the chart.
My current code is:
Dim rng As Range
Set rng = Selection
' add a chart and select it - Selection becomes this chart
ActiveSheet.Shapes.AddChart.Select
'paste selection into cell C4 of Sheet2
rng.Copy Destination:=Sheets("Sheet2").Range("C4")
Sheets("Sheet2").Activate
With ActiveChart
'Chart type is Clustered Bar chart
.ChartType = xlBarClustered
'Set a chart title, located at the top of the chart
.SetElement msoElementChartTitleAboveChart
'Assign the content of cell B1 to the title of the chart
.chartTitle.Text = Worksheets("Sheet1").Range("B1").Value
'Move the chart to a new sheet
.Location Where:=xlLocationAsNewSheet, Name:="Sheet2"
End With
It keeps showing a run-time error 13 with the Set rng = Selection and then sometimes an out of range error pops up around the copy.destination.
My thinking is that because there is not yet a sheet named "Sheet2", that is why the out of range error pops up, but when I make a sheet named Sheet2, a method SetElement of Chart object failed error pops up. I have tried with the Copy destinatinon lines being within the with ActiveChart and outside it, and it doesn't seem to make a difference.
So I am essentially stuck and any help with this would be greatly appreciated.
As commented by Tim Williams, this could work for you:
Sub so75496418AddChart()
Dim rng As Range
Dim strTypeName As String, strNewSheetName As String
strTypeName = TypeName(Selection)
If strTypeName = "Range" Then
Set rng = Selection
If WorksheetFunction.CountA(rng) = 0 Then
MsgBox "No data in range."
Set rng = Nothing
Exit Sub
End If
'paste selection into cell C4 of Sheet2
'rng.Copy Destination:=Sheets("Sheet2").Range("C4")
strNewSheetName = "Sheet" & (Sheets.Count + 1)
With ActiveSheet.Shapes.AddChart.Chart
'Chart type is Clustered Bar chart
.ChartType = xlBarClustered
.SetSourceData Source:=rng
'Set a chart title, located at the top of the chart
.SetElement msoElementChartTitleAboveChart
'Assign the content of cell B1 to the title of the chart
.ChartTitle.Text = ActiveSheet.Range("B1").Value
'Move the chart to a new sheet
.Location Where:=xlLocationAsNewSheet, Name:=strNewSheetName
End With
' move the sheet as the last sheet:
Sheets(strNewSheetName).Move after:=Sheets(Sheets.Count)
Set rng = Nothing
Else
MsgBox "Current selection is not a range, but a " & strTypeName & "."
End If
End Sub
I added .SetSourceData Source:=rng for data source, as a chart without any data, .SetElement msoElementChartTitleAboveChart will fail.
Ref. https://learn.microsoft.com/en-us/office/vba/api/excel.chart.setsourcedata
I need to plot charts at a predefined position in my worksheet when I run the macro to plot the charts. The problem is that the charts are automatically plotted in a weird manner and I don't like that. I want to make sure I can predefine the exact positions at which I want the charts to be plotted on running the macro. I have attached 2 images here, 1 image shows how it's currently plotted and the other shows how I want the charts to be plotted. Any kind of help would be highly appreciated.
This is how I want the charts to be shown on the sheet:
This is how it's currently showing up, with one pie chart overlapping the other and the line chart obscuring the macro buttons as well
This is the code I used, starting with the line chart, followed by the pie charts. I'm new to VBA and coding so please excuse the code structure.
' CHART Code
Dim chart As chart
Dim k As Integer
Dim p As Integer
Dim j As Integer
Dim arrDEM() As Long
Dim arrDATE() As Integer
ReDim arrDEM(1 To 65) As Long
ReDim arrDATE(1 To 65) As Integer
Dim DEM As Integer
j = findcell.Select
ActiveCell.Offset(0, 1).Select
For DEM = 1 To 65
arrDEM(DEM) = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
Next DEM
Debug.Print arrDEM(65)
Range("B1").Activate
For p = 1 To 65
arrDATE(p) = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
Next p
Debug.Print arrDATE(65)
Range("B31:B031") = arrDEM
Range("B31:B031").Select
Set cht1 = ActiveSheet.ChartObjects.Add(Left:=200, Width:=4500, Top:=200, Height:=4000)
ActiveSheet.Shapes.AddChart.Select
Set chart = ActiveChart
chart.ChartType = 4
chart.SeriesCollection(1).Name = x
chart.SeriesCollection(1).XValues = arrDATE
chart.SeriesCollection(1).Values = arrDEM
With ActiveChart
'chart name
.HasTitle = True
.ChartTitle.Characters.Text = "Demand Distribution"
'X axis name
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Weeks"
'y-axis name
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Demand"
'Copy chart from Original file
ActiveChart.ChartArea.Copy
'Paste chart in destination file
Worksheets("Model Calculations").Paste
'Deleting Charts
Worksheets("Sheet1").ChartObjects.Delete
'Activating destination chart
Worksheets("Model Calculations").Activate
Application.DisplayAlerts = False
End With
' PieC Macro
Range("C10:D11").Select
ActiveSheet.Shapes.AddChart2(262, xl3DPie).Select
ActiveChart.SetSourceData Source:=Range("'Model Calculations'!$C$10:$D$11")
With ActiveChart
'chart name
.HasTitle = True
.ChartTitle.Characters.Text = "Continuous Review"
' .Name = "Continuous Chart"
End With
' PieP Macro
'
Range("C10,D10,C12,D12").Select
ActiveSheet.Shapes.AddChart2(262, xl3DPie).Select
ActiveChart.SetSourceData Source:=Range("'Model Calculations'!$C$10,'Model Calculations'!$D$10,'Model Calculations'!$C$12,'Model Calculations'!$D$12")
With ActiveChart
'chart name
.HasTitle = True
.ChartTitle.Characters.Text = "Periodic Review"
'.Name = "Periodic Chart"
End With
End Sub
Your code could use some help in a number of ways. To answer your question, I'll ignore all that, and fix one piece of code. Here is what I'm replacing:
' PieC Macro
Range("C10:D11").Select
ActiveSheet.Shapes.AddChart2(262, xl3DPie).Select
ActiveChart.SetSourceData Source:=Range("'Model Calculations'!$C$10:$D$11")
With ActiveChart
'chart name
.HasTitle = True
.ChartTitle.Characters.Text = "Continuous Review"
' .Name = "Continuous Chart"
End With
I'll start by declaring and assigning a few variables, then create, populate, and position a chart.
Dim WkSht As Worksheet
Set WkSht = Worksheets("Model Calculations")
WkSht.Activate
Dim rChartData As Range
Set rChartData = WkSht.Range("C10:D11")
Dim rChartCover As Range
Set rChartCover = WkSht.Range("F10:K18")
Dim NewChart As Chart
Set NewChart = WkSht.Shapes.AddChart2(262, xl3DPie).Chart
With NewChart
.SetSourceData rChartData
With .Parent
.Left = rChartCover.Left
.Top = rChartCover.Top
.Width = rChartCover.Width
.Height = rChartCover.Height
End With
End With
You could replace this:
Set WkSht = Worksheets("Model Calculations")
WkSht.Activate
with this:
Set WkSht = ActiveSheet
to make it more general, and if you know the position and size of the resulting chart, you can plug those in instead of using the position and size of a given range (like I used rChartCover above).
I have the following macro which plots a Scatter graph for three columns. One column (AL13, downwards) is on the x axis. How do I get it to plot the other two columns (AK and AM) onto the same scatter? Also in different colour to each other? Thank You
Sub Graphing()
Set rng4 = ActiveSheet.Range(Range("AP13"), Range("AV33"))
With ActiveSheet.ChartObjects.Add(Left:=rng4.Left, Width:=rng4.Width, Top:=rng4.Top, Height:=rng4.Height)
.Chart.ChartType = xlXYScatter
.Chart.HasLegend = False
.Chart.Axes(xlCategory).TickLabels.Font.Size = 18
.Chart.Axes(xlValue).TickLabels.Font.Size = 18
Set srs = .Chart.SeriesCollection.NewSeries
srs.Values = Range(Range("AK13"), Range("AK13").End(xlDown))
srs.XValues = Range(Range("AL13"), Range("AL13").End(xlDown))
srs.Values = Range(Range("AM13"), Range("AM13").End(xlDown))
End With
End Sub
I will repost the code that I revised for you above, thanks for crediting me :)
Sub Graphing()
'Declare all the variables to be used:'
Dim rng4 as Range
Dim srs as Series
Dim cht as Chart
Dim xVals as Range
Dim srsVals as Range
'Set the chart's data range:'
Set rng4 = ActiveSheet.Range(Range("AP13"), Range("AV33"))
'Set the range variable to contain the series values'
' You can later modify this to include any number of columns, and the '
' loop structure below will add each column as a series to the chart.'
Set srsVals = ActiveSheet.Range(Range("AL13"),Range("AM13").End(xlDown))
'Set the cht variable:'
Set cht= ActiveSheet.ChartObjects.Add(Left:=rng4.Left, Width:=rng4.Width, Top:=rng4.Top, Height:=rng4.Height).Chart
'Set the Range variable for xValues:
Set xVals = Range(Range("AK13"),Range("AK13").End(xlDown))
'Format the chart and add series to the chart by iterating over the columns in srsVals:'
With cht
.ChartType = xlXYScatter
.HasLegend = False
.Axes(xlCategory).TickLabels.Font.Size = 18
.Axes(xlValue).TickLabels.Font.Size = 18
'Create the series in a loop
For c = 1 to srsVal.Columns.Count
Set srs = .SeriesCollection.NewSeries
With srs
.Values = xVals
.XValues = Range(srsVals.Columns(c).Address)
.Name = "Series " & c '<-- Modify as needed.'
End With
Next
End With
End Sub
I found that if I set the series as two separate series then it will plot both and give them different colours. Not sure if it is the most efficient way of doing it but it works.
Sub Graphing()
'Declare all the variables to be used:'
Dim rng4 as Range
Dim srs as Series
Dim cht as Chart
Dim xVals as Range
Dim srsVals as Range
'Set the chart's data range:'
Set rng4 = ActiveSheet.Range(Range("AP13"), Range("AV33"))
'Set the range variable to contain the series values'
' You can later modify this to include any number of columns, and the '
' loop structure below will add each column as a series to the chart.'
Set srsVals = ActiveSheet.Range(Range("AL13"),Range("AM13").End(xlDown))
'Set the cht variable:'
Set cht= ActiveSheet.ChartObjects.Add(Left:=rng4.Left, Width:=rng4.Width, Top:=rng4.Top, Height:=rng4.Height).Chart
'Set the Range variable for xValues:
Set xVals = Range(Range("AK13"),Range("AK13").End(xlDown))
'Format the chart and add series to the chart by iterating over the columns in srsVals:'
With cht
.ChartType = xlXYScatter
.HasLegend = False
.Axes(xlCategory).TickLabels.Font.Size = 18
.Axes(xlValue).TickLabels.Font.Size = 18
'Create the series in a loop
For c = 1 to srsVal.Columns.Count
Set srs = .SeriesCollection.NewSeries
With srs
.Values = xVals
.XValues = Range(srsVals.Columns(c).Address)
.Name = "Series " & c '<-- Modify as needed.'
End With
Next
End With
End Sub
I have a macro that charts data for me. Everything about the macro works with 1 exception: I want to redesignate the x-axis labels. The macro does do this but it doesn't do it right. In some cases it frame shifts the categories, in others it labels a category completely wrong. The macro is supposed to chart the data by product ID (one chart per product ID) and then change the x-axis category to the label in column F on "Chart Data."
Thanks, in advance, for your help.
Below is the part of the macro that creates the charts and subsequently changes the x axis:
Sub MakeCharts()
Dim sh As Worksheet
Dim rAllData As Range
Dim rChartData As Range
Dim cl As Range
Dim rwStart As Long, rwCnt As Long
Dim chrt As Chart
Set sh = ActiveSheet
ActiveSheet.Range("a1").Select
With sh
' Get reference to all data
Set rAllData = .Range(.[A2], .[A2].End(xlDown)).Resize(, 5)
' Get reference to first cell in data range
rwStart = 1
Set cl = rAllData.Cells(rwStart, 1)
Do While cl <> ""
' cl points to first cell in a station data set
' Count rows in current data set
rwCnt = Application.WorksheetFunction. _
CountIfs(rAllData.Columns(1), cl.Value)
' Get reference to current data set range
Set rChartData = rAllData.Cells(rwStart, 1).Resize(rwCnt, 5)
' Create Chart next to data set
Set chrt = .Shapes.AddChart(xlLineMarkers, _
rChartData.Width, .Range(.[A2], cl).Height).Chart
With chrt
.SetSourceData Source:=rChartData.Offset(0, 1).Resize(, 4)
' -----> Set any chart properties here <-----
' Add Title
.SetElement msoElementChartTitleCenteredOverlay
.ChartTitle.Caption = cl.Value
'Change chart name
.Parent.Name = cl.Value
'Remove Legend
.SetElement (msoElementLegendNone)
' Adjust plot size to allow for title
.PlotArea.Height = .PlotArea.Height - .ChartTitle.Height
.PlotArea.Top = .PlotArea.Top + .ChartTitle.Height
'Change the x-axis to a more organized set
.SeriesCollection(1).XValues = "='Chart Data'!$F$2:$F$1048576"
'Set Max and Min for charts
.Axes(xlValue).MinimumScale = Sheets("Chart Data").Range("K1")
.Axes(xlValue).MaximumScale = Sheets("Chart Data").Range("K2")
'Adjust x-axis to tilt 45 degrees top left to bottom right
.Axes(xlCategory).TickLabels.Orientation = 45
End With
' Get next data set
rwStart = rwStart + rwCnt
Set cl = rAllData.Cells(rwStart, 1)
Loop
End With
under 'Change the x-axis to a more organized set, I used the following code:
.SeriesCollection(1).XValues = "='Chart Data'!" & rChartData.Offset(, 5).Resize(, 1).Address
I'm trying to make a macro that will run through an excel sheet and go through a set of rows and make a graph for each row.
I've got a bit of code that kind of does what I need, but puts it all on one graph when I need an individual graph for each row.
`Dim i As Integer
Dim ws As Worksheet
Set ws = Sheets("Master Sheet")
For Row = 1 To 20
Dim my_cell
Dim rng As Range
Set rng = Sheets("Master Sheet").Range("J8:Y8")
For Each my_cell In rng
If my_cell <> "" Then
ActiveSheet.Shapes.AddChart.Select
ActiveChart.SetSourceData Source:=Range("'Master Sheet'!$J$8:$Y$8")
ActiveChart.ChartType = xlLineMarkers
ActiveChart.Location Where:=xlLocationAsNewSheet
ActiveSheet.Activate
ActiveChart.PlotArea.Select
ActiveChart.SeriesCollection(1).XValues = "='Master Sheet'!$J$2:$Y$2"
ActiveChart.SeriesCollection(1).Name = "=""FP"""
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(2).Name = "=""Progress"""
ActiveChart.SeriesCollection(2).Values = _
"='Master Sheet'!$J$8,'Master Sheet'!$AF$8:$AH$8"
ActiveChart.DisplayBlanksAs = xlInterpolated
ActiveSheet.Activate
ActiveChart.ChartArea.Select
Else
Exit For ' Blank cell found, exiting
End If
Next
Next Row
End Sub`
If anyone can give me a hand to see where I'm going wrong that would be great.
Not really sure you have structured your For Next and For Each loops well. Ideally you'd like to step through ranges and actually use the value you define in your For Each statement. Without seeing your workbook I just adapted a small range of data to simulate creating a graph.
I just took your same code and generate a graph on the same worksheet for each row of numbers. You can take these principles and apply it to your logic.
Sub test()
Dim Row As Integer
Dim ws As Worksheet
Dim rng As Range
Set ws = Sheets("Sheet1") 'Change this to: Set ws = Sheets("Master Sheet")
For Row = 1 To 6
Set rng = ws.Range("B1:D1").Offset(Row, 0) 'Change to (I'm guessing here): ws.Range("$J$7:$Y$7").Offset(Row, 0)
ActiveSheet.Shapes.AddChart.Select
ActiveChart.SetSourceData Source:=Range(ws.Name & "!" & rng.Address)
ActiveChart.ChartType = xlLineMarkers
ActiveChart.PlotArea.Select
ActiveChart.SeriesCollection(1).XValues = "='Sheet1'!$B$1:$D$1" 'Change to "='Master Sheet'!$J$2:$Y$2"
ActiveChart.SeriesCollection(1).Name = ws.Range("A1").Offset(Row, 0).Value 'Change this to whatever you want to name the graphs. This is currently set to dynamicly name each graph by the series name set in Column A.
'ActiveChart.Location Where:=xlLocationAsNewSheet 'uncomment this line to put on new sheet
'ws.Select 'Need to go back to worksheet
Next Row
Set ws = nothing
Set rng = nothing
End Sub
Here are a couple links that may help;
Creating and positioning graphs in a for loop VBA and
Excel VBA: Chart-making macro that will loop through unique name groups and create corresponding charts?
Google also has many other links.
If I've misunderstood your question or need anything else please let me know.
Cheers