How can I place two different sheets on one page.
I create a chart with this code
'Create a chart
Set cht = Worksheets("Dashboard").Shapes.AddChart2
'Set cht = ActiveSheet.Shapes.AddChart2
With cht
.Chart.SetSourceData Source:=rng 'Give chart some data
.Chart.ChartType = xlColumnStacked 'Determine the chart type
.Chart.PlotBy = xlColumns
.ScaleHeight 1.7, msoFalse
.Chart.SetElement (msoElementLegendRight)
.Chart.ChartTitle.Text = Range("E1")
End With
Worksheets("Dashboard").Select
ActiveSheet.ChartObjects(1).Name = "FalseCall"
Range("A1") = ActiveSheet.ChartObjects(1).Name
ActiveSheet.Shapes("FalseCall").Left = Range("A1").Left
ActiveSheet.Shapes("FalseCall").Top = Range("A1").Top
ActiveSheet.Shapes("FalseCall").Width = Range("A1:G1").Width
ActiveSheet.Shapes("FalseCall").Height = Range("A1:A26").Height
It will add a chart on sheet "Dashboard".
Next I want to add a new chart with another name on the same page on H1 with
ActiveSheet.ChartObjects(1).Name = "Ng"
The existing chart will be renamed with the name of the second Chart and moves to H1, instead of the new chart is getting that name and moving the H1
It's not more complicated than repeating the steps with new ranges specified.
Sub InsertTwoCharts()
Dim ws As Worksheet
Set ws = Worksheets("Dashboard")
' CHART 1
' range that chart will cover
Dim ChtRng1 As Range
Set ChtRng1 = ws.Range("A1:G26")
' chart data range
Dim ChtData1 As Range
Set ChtData1 = Worksheets("Whatever").Range("A1:E12") ' or whatever
' insert and modify the chart
Dim cht1 As ChartObject
Set cht1 = ws.Shapes.AddChart2
With cht1
.Name = "FalseCall"
.Chart.SetSourceData Source:=ChtData1, PlotBy:=xlColumns
.Chart.ChartType = xlColumnStacked
.Chart.SetElement msoElementLegendRight
.Chart.ChartTitle.Text = ws.Range("E1").Value ' pick a worksheet and cell
.Left = ChtRng1.Left
.Top = ChtRng1.Top
.Width = ChtRng1.Width
.Height = ChtRng1.Height
End With
' CHART 2
' range that chart will cover
Dim ChtRng2 As Range
Set ChtRng2 = ws.Range("H1:N26")
' chart data range
Dim ChtData2 As Range
Set ChtData2 = Worksheets("Whatever").Range("G1:K12") ' or whatever
' insert and modify the chart
Dim cht2 As ChartObject
Set cht2 = ws.Shapes.AddChart2
With cht2
.Name = "TrueCall"
.Chart.SetSourceData Source:=ChtData1, PlotBy:=xlColumns
.Chart.ChartType = xlColumnStacked
.Chart.SetElement msoElementLegendRight
.Chart.ChartTitle.Text = ws.Range("H1").Value ' pick a worksheet and cell
.Left = ChtRng2.Left
.Top = ChtRng2.Top
.Width = ChtRng2.Width
.Height = ChtRng2.Height
End With
End Sub
Related
I am trying to create a code which adds series to a scatter-graph. The code runs but there is about 100 extra series of data added which were not specified. My vba skills are basic.
Dim DownSweep As Chart
Dim xrng As Range
Dim yrng As Range
Dim title As Range
Dim dsvt As Worksheet
Dim dst As Worksheet
Dim i As Integer
t = 1
CLEAN:
If t < ActiveWorkbook.Charts.Count + 1 Then
If ActiveWorkbook.Charts(t).Name = "DownSweep Graph" Then
Application.DisplayAlerts = False
ActiveWorkbook.Charts("DownSweep Graph").Delete
Application.DisplayAlerts = True
t = t + 1
GoTo CLEAN
End If
End If
Set dst = Worksheets("Template 2 - Down Sweep")
Set dsvt = Worksheets("DownSweep ViscosityTemperature")
Set xrng = dsvt.Range(dsvt.Range("C2"), dsvt.Range("C2").End(xlDown))
Set yrng = dsvt.Range(dsvt.Range("F2"), dsvt.Range("F2").End(xlDown))
Set title = dsvt.Range("F1")
dsvt.Range("E1").Select
Set DownSweep = Charts.Add
DownSweep.Name = "DownSweep Graph"
With DownSweep
.ChartType = xlXYScatter
.SeriesCollection.NewSeries
.SeriesCollection(1).XValues = xrng
.SeriesCollection(1).Values = yrng
.SeriesCollection(1).Name = title
End With
title = title.Offset(0, 1)
For i = 2 To 99
With DownSweep.SeriesCollection.NewSeries()
.XValues = xrng.Offset(0, i - 1).Value
.Values = yrng.Value
.Name = title
End With
title = title.Offset(0, i)
Next i
End Sub
How do I prevent this from happening?
Any help would be appreciated.
That's because you're selecting a cell within the source data prior to adding the chart. So it automatically sets that data as it's source and creates the series collection.
Therefore, either make sure that the active cell does not reside within the source data or use the following code to delete the existing series collection prior to adding your new series collection.
With DownSweep
Do While .SeriesCollection.Count > 0
.SeriesCollection(1).Delete
Loop
End With
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 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 made a code to create a one chart by vba excel. But I am not able to make a code where I can generate several graphs in the same worksheet, that is, I have 4 columns, I want to create 4 graphs.
Could someone help me with this task?
This is my code:
Sub create_BarChart()
Dim myWorksheet As Worksheet
Dim mySourceData As Range
Dim myChart As Chart
Dim myShape As Shape
Dim myChartDestination As Range
Set myWorksheet = ThisWorkbook.Worksheets("corelacao")
Set myChartDestination = myWorksheet.Range("D36:H45")
Set myShape = myWorksheet.Shapes.AddChart(Excel.XlChartType.xl3DBarClustered)
Set myChart = myShape.Chart
With myChart
.SetSourceData Source:=myWorksheet.Range("B1:C32")
.ChartTitle.Text = "Analise de correlações"
.Legend.Left = 250 'posição vertical
.Legend.Width = 300 '100
.Parent.Height = 200
.Parent.Width = 269
.Parent.Left = 95
End With
With myShape
.Height = 325 ' resize
.Top = 300 ' reposition
.Left = 100 ' reposition
.Fill.ForeColor.RGB = RGB(230, 225, 220)
.Fill.Solid
End With
End Sub
I would specify input ranges for the chart in an array variable and look thru the array to generate the charts:
Dim arr(2) As String
Dim mySourceData As Range
Dim myChart As Chart
Dim myShape As Shape
Dim myChartDestination As Range
Dim myWorksheet As Worksheet
Set myWorksheet = ActiveSheet
'Data area for each chart
arr(1) = "B1:C32"
arr(2) = "B1:B31,D1:D31"
For a = 1 To 2
Set myChartDestination = myWorksheet.Range("D36:H45")
Set myShape = myWorksheet.Shapes.AddChart(Excel.XlChartType.xl3DBarClustered)
Set myChart = myShape.Chart
With myChart
.SetSourceData Source:=myWorksheet.Range(arr(a))
.ChartTitle.Text = "Analise de correlações"
.Legend.Left = 250
.Legend.Width = 300
.Parent.Height = 200
.Parent.Width = 269
.Parent.Left = 95
End With
With myShape
.Height = 325
.Top = 300
.Left = 100 + ((a - 1) * 250)
.Fill.ForeColor.RGB = RGB(230, 225, 220)
.Fill.Solid
End With
Next
59.30 15 16 17
1 1,162,912,036.90 1,248,737,016.99 1,306,573,912.08
2 245,665,383.94 261,416,880.69 276,613,283.05
3 393,313,441.29 379,169,039.15 418,680,492.19
4 13,920,572.74 14,464,854.92 15,120,474.58
5 54,501,581.55 56,319,351.21 58,832,588.24
6 15,165,376.28 11,694,942.56 10,809,661.03
7 194,397,643.30 170,427,013.85 182,567,862.46
8 15,165,376.28 11,694,942.56 10,809,661.03
9 2,079,876,036.00 2,142,229,099.38 2,269,198,273.62
3% 6%
There are 7 tables like the above data in one excel tab in different area.I want to create a stacked column chart for each table. I wrote a code to create. Just want to know is that possiable to use loop to solve this problem? Code attached.
Sub FormatChartNIX()
'PURPOSE: Create a chart (chart dimensions are not required)
Dim rng As Range
Dim cht As Object
Dim ser As Series
Dim tmpCHR As ChartObject
'Chart1
'Your data range for the chart
Set rng = ActiveSheet.Range("B8:E17")
'Create a chart
Set cht = ActiveSheet.Shapes.AddChart
'Give chart some data
cht.chart.SetSourceData Source:=rng, PlotBy:=xlRows
'Determine the chart type
cht.chart.ChartType = xlColumnStacked
With ActiveSheet
.ChartObjects(1).Top = .Range("C24").Top
.ChartObjects(1).Left = .Range("C24").Left
End With
ActiveSheet.ChartObjects(1).Activate
ActiveChart.Axes(xlValue).Select
Selection.delete
ActiveChart.HasTitle = True
ActiveChart.ChartTitle.Text = ActiveSheet.Range("c1")
'Chart2
Set rng = ActiveSheet.Range("G8:J17")
Set cht = ActiveSheet.Shapes.AddChart
cht.chart.SetSourceData Source:=rng, PlotBy:=xlRows
cht.chart.ChartType = xlColumnStacked
With ActiveSheet
.ChartObjects(2).Top = .Range("H24").Top
.ChartObjects(2).Left = .Range("H24").Left
End With
ActiveSheet.ChartObjects(2).Activate
ActiveChart.Axes(xlValue).Select
Selection.delete
ActiveChart.HasTitle = True
ActiveChart.ChartTitle.Text = ActiveSheet.Range("h1")
'Chart3
Set rng = ActiveSheet.Range("L8:o17")
Set cht = ActiveSheet.Shapes.AddChart
cht.chart.SetSourceData Source:=rng, PlotBy:=xlRows
cht.chart.ChartType = xlColumnStacked
With ActiveSheet
.ChartObjects(3).Top = .Range("M24").Top
.ChartObjects(3).Left = .Range("M24").Left
End With
ActiveSheet.ChartObjects(3).Activate
ActiveChart.Axes(xlValue).Select
Selection.delete
ActiveChart.HasTitle = True
ActiveChart.ChartTitle.Text = ActiveSheet.Range("h1")
'Chart4
Set rng = ActiveSheet.Range("B82:E91")
Set cht = ActiveSheet.Shapes.AddChart
cht.chart.SetSourceData Source:=rng, PlotBy:=xlRows
cht.chart.ChartType = xlColumnStacked
With ActiveSheet
.ChartObjects(4).Top = .Range("C51").Top
.ChartObjects(4).Left = .Range("C51").Left
End With
ActiveSheet.ChartObjects(4).Activate
ActiveChart.Axes(xlValue).Select
Selection.delete
ActiveChart.HasTitle = True
ActiveChart.ChartTitle.Text = ActiveSheet.Range("c75")
'Chart5
Set rng = ActiveSheet.Range("G82:J91")
Set cht = ActiveSheet.Shapes.AddChart
cht.chart.SetSourceData Source:=rng, PlotBy:=xlRows
cht.chart.ChartType = xlColumnStacked
With ActiveSheet
.ChartObjects(5).Top = .Range("H51").Top
.ChartObjects(5).Left = .Range("H51").Left
End With
ActiveSheet.ChartObjects(5).Activate
ActiveChart.Axes(xlValue).Select
Selection.delete
ActiveChart.HasTitle = True
ActiveChart.ChartTitle.Text = ActiveSheet.Range("h75")
'Chart6
Set rng = ActiveSheet.Range("L82:o91")
Set cht = ActiveSheet.Shapes.AddChart
cht.chart.SetSourceData Source:=rng, PlotBy:=xlRows
cht.chart.ChartType = xlColumnStacked
With ActiveSheet
.ChartObjects(6).Top = .Range("M51").Top
.ChartObjects(6).Left = .Range("M51").Left
End With
ActiveSheet.ChartObjects(6).Activate
ActiveChart.Axes(xlValue).Select
Selection.delete
ActiveChart.HasTitle = True
ActiveChart.ChartTitle.Text = ActiveSheet.Range("m75")
'Chart7
Set rng = ActiveSheet.Range("Q82:T91")
Set cht = ActiveSheet.Shapes.AddChart
cht.chart.SetSourceData Source:=rng, PlotBy:=xlRows
cht.chart.ChartType = xlColumnStacked
With ActiveSheet
.ChartObjects(7).Top = .Range("R51").Top
.ChartObjects(7).Left = .Range("R51").Left
End With
ActiveSheet.ChartObjects(7).Activate
ActiveChart.Axes(xlValue).Select
Selection.delete
ActiveChart.HasTitle = True
ActiveChart.ChartTitle.Text = ActiveSheet.Range("r75")
End Sub
Using named ranges and some arrays you can loop through it.
First, create named ranges for the ranges for each chart.
I added a small table in the spreadsheet and named each one the text in the first cell of the range (i.e., Chart1,... Chart7). The other ranges each go in the next cell, so the range named "Chart 1" is 4 cells.
(I also used the same ranges and cells that you did in your code above)
Chart1 B8:E17 C24 C1
Chart2 G8:J17 H24 H1
Chart3 L8:O17 M24 H1
Chart4 B82:E91 C51 C75
Chart5 G82:J91 H51 H75
Chart6 L82:O91 M51 R75
Chart7 Q82:T91 R51 R75
Sub FormatChartNIX_Modified()
Dim rng As Range
Dim cht As Object
Dim ser As Series
Dim tmpCHR As ChartObject
Dim MyArray(1 To 7, 0 To 3) As String
Dim i As Integer
For i = LBound(MyArray) To UBound(MyArray)
'Set Values - possibly with named ranges
Dim vArray() As Variant
Dim strNamedRange As String
strNamedRange = "Chart" & i
Set rng = Worksheets("Sheet1").Range(strNamedRange)
vArray = rng
Dim j As Integer
For j = LBound(MyArray, 2) To UBound(MyArray, 2)
MyArray(i, j) = vArray(1, j + 1)
Debug.Print MyArray(i, j)
Next j
Next i
For i = LBound(MyArray) To UBound(MyArray)
With ActiveSheet
Set rng = .Range(MyArray(i, 1)) '1 represents the data range
Set cht = .Shapes.AddChart
cht.Chart.SetSourceData Source:=rng, PlotBy:=xlRows
cht.Chart.ChartType = xlColumnStacked
.ChartObjects(i).Top = .Range(MyArray(i, 2)).Top '0 represents the chart name
.ChartObjects(i).Left = .Range(MyArray(i, 2)).Left '2 represents the cell identifying the chart location
.ChartObjects(i).Activate
With ActiveChart
.Axes(xlValue).Select
.Axes(xlValue).Delete
.HasTitle = True
.ChartTitle.Text = ActiveSheet.Range(MyArray(i, 3)).Text '3 represents the cell where the title text is located
End With
End With
Next i
End Sub
Do that, run the sub and it will create 7 charts as described in the table - using a loop.