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
Related
I'm trying to create graphs of every column of data in a worksheet. As of right now it works as long as there are no gaps in the column of data, but I need it to be robust enough that it works if there are gaps in the data. The data is entered in batches with different columns having different lengths due to different measurement requirements. Each of the rows will also have an identifier in the first column indicating what batch of data that row comes from (see attached file). Since the identifier column will be the same length as the longest data column, I compare the last row of that to the bottom row of any given data column to make sure all the data is getting graphed. However right now the it gets stuck in the loop if there's a gap in the data.
Sub GraphAllColumns()
Dim col As Range 'The cell at the top of the data column
Dim bottomRow As Range
Dim bottomData As Range
Set col = ActiveSheet.Range("B7")
Set bottomRow = Range("A7").End(xlDown)
col.Select
If Not IsEmpty(Selection) Then 'If the worksheet is empty, nothing happens
Do
Set bottomData = Selection.End(xlDown)
If bottomRow.Row <= bottomData.Row Then
'Iterate through every column, select all the data in that column
'then call the create graph subroutine
Call CreateGraph
ActiveCell.Offset(0, 1).Select
Else
If IsEmpty(Selection.End(xlDown)) Then
Call CreateGraph
ActiveCell.Offset(0, 1).Select
Else
Range(Selection, Selection.End(xlDown)).Select
End If
End If
Loop Until IsEmpty(Selection)
End If
End Sub
Here's the CreateGraph subroutine as well. I'm happy the way that it works. I know it isn't the best way, but this is my first time using VBA.
Sub CreateGraph()
Dim startCell As Range 'Starting cell (important for column selection)
Dim graphRange As Range
Set startCell = Selection
Set graphRange = Range(startCell, startCell.End(xlDown)) 'Selects all data in column
'Create chart, define chart type and source data
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlLine
ActiveChart.SetSourceData Source:=graphRange
'Change chart location so that all charts on a sheet are stacked in top left corner
With ActiveChart.Parent
.Top = Range("A1")
.Left = Range("A1")
End With
'Change chart title and other attributes
With ActiveChart
.HasTitle = True
.ChartTitle.Text = startCell.Offset(-2, 0).Value
End With
End Sub
I may still be misunderstanding what you want, but this should get you started.
Sub PlotDataById()
Dim dict As Object, id, ws As Worksheet, rngId As Range
Set ws = ActiveSheet 'or whatever
Set dict = IdRanges(ws.Range("B3")) 'get the ranges for each id
For Each id In dict
Set rngId = dict(id).Offset(0, 1) 'first set of data
Debug.Print "Plotting id - " & id & ":" & rngId.Address
Do While Application.CountA(rngId) > 0
'use resize() to pass only the occupied range
CreateGraph rngId.Resize(Application.CountA(rngId)), id
Set rngId = rngId.Offset(0, 1) 'next column over
Loop
Next id
End Sub
'Capture the ranges occupied by each id in a list, starting at `startCell`
' Assumes list is sorted by id
Function IdRanges(startCell As Range) As Object
Dim c As Range, id, currId, cStart As Range, dict As Object
Set dict = CreateObject("scripting.dictionary")
currId = Chr(0) 'some non-value
Set c = startCell
Do While Len(c.Value) > 0
id = c.Value
If id <> currId Then
If Not cStart Is Nothing Then
dict.Add currId, c.Parent.Range(cStart, c.Offset(-1, 0))
End If
Set cStart = c
currId = id
End If
Set c = c.Offset(1, 0)
Loop
dict.Add currId, c.Parent.Range(cStart, c.Offset(-1, 0))
Set IdRanges = dict
End Function
'Create a plot of `rngData` with title `chtTitle`
Sub CreateGraph(rngData As Range, chtTitle)
Dim co As Shape, cht As Chart, ws As Worksheet
Set ws = rngData.Parent
Set co = ws.Shapes.AddChart
With co.Chart
.ChartType = xlLine
.SetSourceData Source:=rngData
.HasTitle = True
.ChartTitle.Text = chtTitle
End With
With co 'all charts on a sheet are stacked in top left corner
.Top = ws.Range("A1").Top
.Left = ws.Range("A1").Left
End With
End Sub
Using Select/ActiveCell is not a very robust way to structure your code, and typically you can avoid almost all uses of that approach.
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
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'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
I'm trying to write a macro to create graphs in excel 2007. I don't know the number of cells that will be in the range for one of the series of data (it could be anywhere from 50 - 1000). I've googled this and I've found answers but they are all over the map and the few I've tried haven't helped me at all.
I'm a newb at vba macros but am an experienced programmer.
I've found examples such as:
Sub FindLast2()
x = ActiveSheet.UsedRange.Rows.Count
ActiveCell.SpecialCells(xlLastCell).Select
End Sub
I'm not sure if this works & if it does work how would I incorporate that into my macro
Here's my macro as it stands now:
Sub temp_graph_5()
'
' temp_graph_5 Macro
'
'
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(2).Select
Sheets(2).Name = "Temperature"
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlLine
ActiveChart.SetSourceData Source:=Sheets(1). _
Range("B2:B324")
ActiveChart.SeriesCollection(1).Name = "=""Temperature"""
End Sub
The 'B324' is the section that I need to be variable.
Any help is greatly appreciated.
This code may help achieve what you need:
Sub temp_graph_5()
Dim myRng As Range
Dim lastCell As Long
//Get range to be plotted in chart
lastCell = Worksheets(1).Range("B2").End(xlDown).Row
Set myRng = Worksheets(1).Range("B2:B" & lastCell)
//Add worksheet and name as "Temperature"
Dim newSheet As Worksheet
Set newSheet = Worksheets.Add(After:=Worksheets(Worksheets.Count))
newSheet.Name = "Temperature"
newSheet.Select
//Add a new chart in Temperature and plot values from sheet 1
Charts.Add
With ActiveChart
.ChartType = xlLine
.SetSourceData Source:=myRng, PlotBy:=xlColumns
.Location Where:=xlLocationAsObject, Name:="Temperature"
End With
End Sub
sub test()
last_row_all = Range("A65536").End(xlUp).Row
msgbox last_row
end sub