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
Related
I would like to create a macro that runs through a series of data in a table and is able to automatically create multiple formatted graphs from it.
Here is what I'm working with (below):
Sub MakeXYGraph()
'https://stackoverflow.com/questions/62285791/dynamically-select-cells-and-input-in-chart
Dim ws As Worksheet
Set ws = Sheet1 'This is the codename of the sheet where the data is
'For the test, deleting all the previous charts
Dim vChartObject As ChartObject
For Each vChartObject In ws.ChartObjects
vChartObject.Delete
Next vChartObject
'rngData is the range where the data are. It is assumed that nothing else is on the sheet than what you displ
Dim rngData As Range
Set rngData = ws.UsedRange.Offset(1).Resize(ws.UsedRange.Rows.Count - 1)
' Get the number of series
Dim iMaxSeries As Integer
iMaxSeries = Application.WorksheetFunction.Max(rngData.Columns(1))
' Is the actual Series, but in the sheet it called Point
Dim iPoint As Integer
'Used for setting the ranges for the series data
Dim lFirstRow As Long, lLastRow As Long, lFirstColumn As Long, lLastColumn As Long
lFirstColumn = rngData(1).Column
lLastColumn = rngData.Columns(rngData.Columns.Count).Column
'Creating the Chart
Dim cht As ChartObject
Set cht = ws.ChartObjects.Add(Left:=250, Width:=500, Top:=50, Height:=300)
With cht.Chart
.ChartType = xlXYScatterLines
'X axis name
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Vertical Displacement"
'Y-axis name
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Vertical Coordinate"
' deleting the unwanted series (Excel tries to find out the data, but no need for it.)
Do Until .SeriesCollection.Count = 0
.SeriesCollection(1).Delete
Loop
End With
For iPoint = 1 To iMaxSeries
'Search for the first occurence of the point
lFirstRow = rngData.Columns(1).Offset(-1).Find(what:=iPoint).Row
'Search for the first occurence of the second point -1 is the last of this point
If iPoint = iMaxSeries Then
lLastRow = rngData.Rows(rngData.Rows.Count).Row - 1
Else
lLastRow = rngData.Columns(1).Find(what:=iPoint + 1).Row - 1
End If
'Add the series
With cht.Chart.SeriesCollection.NewSeries
.XValues = ws.Range(Cells(lFirstRow, lFirstColumn + 1), Cells(lLastRow, lLastColumn - 1))
.Values = ws.Range(Cells(lFirstRow, lFirstColumn + 2), Cells(lLastRow, lLastColumn))
.Name = "Point " & CStr(iPoint)
End With
Next iPoint
End Sub
Which plots the vertical coordinate vs. vertical displacement columns from this table:
To create this graph:
However, as you can see from the image with the table, I have multiple columns, and I would like to like to make graphs for several columns, all with the same format as the vertical coordinate vs. vertical displacement chart above, without interfering with the previous charts created. For example, the second graph that I would like to create is vertical coordinate vs. vertical stress. There is additional data on this worksheet, so one cannot just assume that the rest of the worksheet is blank.
One issue is that as you can see there are four different point numbers (1,2,3,4) and each point number is iterated 9 times. However, these numbers can change (for example there could be 8 Point numbers with three iterations each, and thus the data is dynamic and shouldn't just consider 4 Point No.'s with 9 iterations). And the table data will always be located starting from cell "C8". The current code deals with this.
The reason why the current code doesn't satisfy this is because it assumes that there is no other data on the worksheet where the table is (but there is). I want to be able to add more columns and create more charts (all of them plotted against vertical coordinate column) without affecting the other charts. Please if there is any way to modify the code so then I could create charts for several sets of data on the same worksheet then that would be much appreciated! I'm not sure what the best way to approach this is. Thank you.
https://drive.google.com/file/d/1cuW2eWYwrkNeJ-TmatiC4-PFodflNbSN/view?usp=sharing
Here's one approach:
Sub MakeXYGraph()
Const PLOT_HEIGHT As Long = 200
Const PLOT_WIDTH As Long = 300
Dim ws As Worksheet
Dim cht As ChartObject
Dim rngData As Range, rngHeaders As Range
Dim col As Long, posTop As Long, posLeft As Long
Dim ptRanges As Object, pt, dataRows As Range, i As Long
Set ws = Sheet1 'This is the codename of the sheet where the data is
For i = ws.ChartObjects.Count To 1 Step -1
ws.ChartObjects(i).Delete
Next i
Set rngData = ws.Range("C7").CurrentRegion
Set rngHeaders = rngData.Rows(1) 'the header row
Set rngData = rngData.Offset(1, 0).Resize(rngData.Rows.Count - 1) 'just the data
Set ptRanges = PointRanges(rngData.Columns(1))
posTop = ws.Range("M2").Top
posLeft = ws.Range("M2").Left
For col = 3 To rngData.Columns.Count
'add the chart
Set cht = NewChart(ws, posLeft, PLOT_WIDTH, posTop, PLOT_HEIGHT, rngHeaders.Cells(col).Value)
'loop over the keys of the dictionary containing the point numbers and corresponding ranges
For Each pt In ptRanges
Set dataRows = ptRanges(pt).EntireRow
With cht.Chart.SeriesCollection.NewSeries
.XValues = dataRows.Columns(rngData.Columns(col).Column)
.Values = dataRows.Columns(rngData.Columns(2).Column)
.Name = "Point " & pt
End With
Next pt
posTop = posTop + PLOT_HEIGHT
Next col
End Sub
'Scan the "point No" column and collect unique values and
' corresponding ranges in a Scripting Dictionary object
' assumes data is sorted by point no
Function PointRanges(pointsRange As Range) As Object
Dim dict As Object, c As Range, p, rng As Range
Set dict = CreateObject("scripting.dictionary")
For Each c In pointsRange.Cells
p = c.Value
If Not dict.exists(p) Then
dict.Add p, c 'add the start cell
Else
Set dict(p) = dict(p).Resize(dict(p).Count + 1) 'resize to add this cell
End If
Next c
Set PointRanges = dict
End Function
'add a chart and do some initial configuration
Function NewChart(ws As Worksheet, L, W, T, H, yAxisName As String)
Dim cht As ChartObject
Set cht = ws.ChartObjects.Add(Left:=L, Width:=W, Top:=T, Height:=H)
With cht.Chart
.ChartType = xlXYScatterLines
.Axes(xlCategory, xlPrimary).HasTitle = True 'X axis name
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = yAxisName
.Axes(xlValue, xlPrimary).HasTitle = True 'Y-axis name
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Vertical Coordinate"
.Axes(xlValue, xlPrimary).ReversePlotOrder = True
Do While .SeriesCollection.Count > 0
.SeriesCollection(1).Delete
Loop
End With
Set NewChart = cht
End Function
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
I'm fairly new to VBA and trying to dynamically select the data i need for my scatter plot. I'm trying skip any rows that have a blank in the "A" column so the scatter plot is continuous.
The code in the commented section is what i tried first, but that gives me a method range of object_global failed error on the setsourcedata line. I expect the code to skip the empty cell and continue through mydatatest variable until it reaches the end. However, the actual output stops at the first empty cell.
Set mydatatest = ActiveWorkbook.Sheets("Data - PLC").Range("A3:A94")
'Set mydata = ActiveWorkbook.Sheets("Data - PLC").Range("A2:C2")
Set mydata = ActiveWorkbook.Sheets("Data - PLC").Range("A2")
For Each mydatapoint In mydatatest
If IsEmpty(mydatapoint) = False Then
'Set mydata = Union(mydata, Range(mydatapoint, mydatapoint.Offset(0, 2)))
Set mydata = Union(mydata, mydatapoint)
End If
Next mydatapoint
ActiveWorkbook.Sheets("Report").Select
Set cht1 = Sheet1.ChartObjects.Add(10, 365, 275, 200)
With cht1.Chart
.ChartType = xlXYScatterLinesNoMarkers
.SeriesCollection.Add Source:=Range(mydata, mydata.Offset(0, 2))
'.SetSourceData Source:=Range(mydata)
End With
The error is in .SetSourceData Source:=Range(mydata). It should be .SetSourceData Source:=myData. myData is already declared as Range(). The rest is quite ok:
Option Explicit
Sub TestMe()
Dim myDataTest As Range
Dim myData As Range
Dim wks As Worksheet
Set wks = Worksheets(1)
Set myDataTest = wks.Range("A3:A94")
Set myData = wks.Range("A2")
Dim myDataPoint As Range
For Each myDataPoint In myDataTest
If Not IsEmpty(myDataPoint) Then
Set myData = Union(myData, myDataPoint)
End If
Next myDataPoint
Dim cht As Object
Set cht = wks.ChartObjects.Add(10, 365, 275, 200)
With cht.Chart
.ChartType = xlXYScatterLinesNoMarkers
.SeriesCollection.Add Source:=wks.Range(myData, myData.Offset(0, 2))
.SetSourceData Source:=myData
End With
End Sub
I am trying to create a xy plot where the x values is the time axis (column A) and the y values are in the other columns. (in the example only C and D)
When I try my code from below, I get a graph with time axis (so column A) and y values all the other columns (B, C, D, E,...) which is unwanted.
I can see that the .seriescollection(1) and (2) overwrite the default y-values (because my range is smaller), but all the others (column B, D, E,...) still remains in the graph.
Any thoughts why? Thanks in advance!
Sub grafieken()
'
' grafieken Macro
'
Dim sh As Worksheet
Dim chrt As Chart
Dim naaaam As String
naaam = ActiveWorkbook.ActiveSheet.Name
Set sh = ActiveWorkbook.Worksheets(naaam)
Set chrt = sh.Shapes.AddChart.Chart
With chrt
'Data?
.ChartType = xlXYScatter
.SeriesCollection.NewSeries
.SeriesCollection(1).Name = sh.Range("$C$1")
.SeriesCollection(1).XValues = sh.Range("$A$2:$A$11")
.SeriesCollection(1).Values = sh.Range("$C$2:$C$11")
.SeriesCollection(2).Name = sh.Range("$D$1")
.SeriesCollection(2).XValues = sh.Range("$A$2:$A$11")
.SeriesCollection(2).Values = sh.Range("$D$2:$D$11")
'Titles?
.HasTitle = True
.ChartTitle.Characters.Text = naaam
End With
End Sub
Sub grafieken()
Dim MySh As Worksheet
Dim chrt As Chart
Dim naaaam As String
naaam = ActiveWorkbook.ActiveSheet.Name
Set MySh = ActiveWorkbook.Worksheets(naaam)
Set chrt = MySh.Shapes.AddChart.Chart
With chrt
'Data?
.SetSourceData Source:=Sheets(naaam).Range("A1:B11")
.ChartType = xlXYScatter
.SeriesCollection.Add Source:=ActiveSheet.Range("E1:E11")
'.SeriesCollection.NewSeries
.SeriesCollection(1).Name = ActiveSheet.Range("$C$1")
.SeriesCollection(1).XValues = ActiveSheet.Range("$A$2:$A$11")
.SeriesCollection(1).Values = ActiveSheet.Range("$C$2:$C$11")
'Titles?
.HasTitle = True
.ChartTitle.Characters.Text = naaam
End With
End Sub
I found a way, I first needed to define the source data for the first series, and change them later into the one I want, this way no unwanted series appears.
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