I am working on Stock OHLC Chart present in Sheets("Exhibit") and selecting Data from Sheets("75Min"). However i am succeeding to choose appropriate data range but can not add at Line Nu 15 .SetSourcedata, could you please help me to get out from this problem
Code is as follows.
Sub Edit75MinChartToOHLCCandlestickChart()
Dim OHLCChart As ChartObject
Dim LastRow As Integer
Dim RngSt As Integer
Sheets("75Min").Select
Range("A1").Select
Range("A1").End(xlDown).Select
LastRow = ActiveCell.Row
RngSt = LastRow - 59
RngEnd = LastRow + 15
Set OHLCChart = ThisWorkbook.Worksheets("Exhibit").ChartObjects(1)
With OHLCChart.Chart 'Worksheets("Exhibit").ChartObjects("Chart 2").Chart
.SetSourceData ThisWorkbook.Worksheets("75Min").Range(RngSt, RngEnd)
.ChartType = xlStockOHLC
.HasTitle = True
.ChartTitle.Text = "75Min Candlestick chart"
.Axes(xlValue, xlPrimary).HasTitle = False
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Price"
.PlotArea.Format.Fill.ForeColor.RGB = RGB(242, 242, 242)
.ChartArea.Format.Line.Visible = msoFalse
.Parent.Name = "OHLC Chart"
End With
End Sub
Thank You
Best to avoid Select and Activate. Your range is not a valid range. You are saying Range(#,#), which isn't valid and I doubt you were trying to get whole rows. Assuming you only wanted the first column, this will work. You can expand the column from 1 if you need the labels.
Sub Edit75MinChartToOHLCCandlestickChart()
Dim OHLCChart As ChartObject
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set ws1 = ThisWorkbook.Worksheets("75Min")
Set ws2 = ThisWorkbook.Worksheets("Exhibit")
Dim MyRng As Range
Dim LastRow As Long
Dim RngSt As Long
Dim RngEnd as Long
LastRow = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row
RngSt = LastRow - 59
RngEnd = LastRow + 15
Set MyRng = ws1.Range(ws1.Cells(RngSt, 1), ws1.Cells(RngEnd, 1))
Set OHLCChart = ws2.ChartObjects(1)
With OHLCChart.Chart 'Worksheets("Exhibit").ChartObjects("Chart 2").Chart
.SetSourceData MyRng
You can include these lines to adjust the Y axis scale:
Dim Ymin As Double, Ymax As Double
Ymin = WorksheetFunction.Min(MyRng)
Ymax = WorksheetFunction.Max(MyRng)
With OHLCChart.Chart.Axes(xlValue)
.MinimumScale = Ymin
.MaximumScale = Ymax
End With
But these are probably going to be ugly axis limits. I've written a tutorial called Calculate Nice Axis Scales in Excel VBA which contains an algorithm to adjust the min and max outwards slightly so that the scale is more human-readable.
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 have written the following code to display a basic line graph.
Sub addchart()
If ActiveSheet.ChartObjects.Count > 0 Then
ActiveSheet.ChartObjects.Delete
End If
Dim ws As Worksheet
Dim ch As chart
Dim dt As Range
Dim i As Integer
i = Cells(Rows.Count, "M").End(xlUp).Row
Set ws = ActiveSheet
Set dt = Range(Cells(2, 14), Cells(i, 14))
Set ch = ws.Shapes.AddChart2(Width:=1300, Height:=300, Left:=Range("a13").Left, Top:=Range("a13").Top).chart
With ch
.SetSourceData Source:=dt
.ChartTitle.Text = "Deflection Curve"
.ChartType = xlLineMarkers
End With
End Sub
But the trouble with this is that the range of Y axis adjusts itself according to the data automatically. I want to fix this range so that the change in the graph is noticeable.
For example, the following two graphs vary in the range of values they cover but they look basically the same because the y axis is adjusting itself. One goes from 0 to -9 and the other from 0 to -25. If I can fix the range to say 0 to -30, the difference in the two graphs would be more apparent.
With ch.Axes(xlValue)
.Minimumscale = -30
.Maximumscale = 0
End with
Relevant links:
Chart.Axes method
Axis Object
Thanks to Spencer, the following code gets the result I want
Sub addchart()
If ActiveSheet.ChartObjects.Count > 0 Then
ActiveSheet.ChartObjects.Delete
End If
Dim ws As Worksheet
Dim ch As chart
Dim dt As Range
Dim i As Integer
i = Cells(Rows.Count, "M").End(xlUp).Row
Set ws = ActiveSheet
Set dt = Range(Cells(2, 14), Cells(i, 14))
Set ch = ws.Shapes.AddChart2(Width:=1300, Height:=300, Left:=Range("a13").Left, Top:=Range("a13").Top).chart
With ch
.SetSourceData Source:=dt
.ChartTitle.Text = "Deflection Curve"
.ChartType = xlLineMarkers
End With
With ch.Axes(xlValue) 'fixing range of values
.MinimumScale = -30
.MaximumScale = 0
End With
End Sub
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
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 have a VBA code (below) that sets the min and max x-axis values to a specified cell (B4 and B15). However, I have many plots in my workbook, and all need a different min and max x-axis range. I want a VBA code that goes to the plotted x-axis range and then finds the min and max value in that range and sets the axis to those values. How can I alter the code below to do that?
Sub Resize_Fonts()
Dim Sht As Worksheet
Dim Cht As ChartObject
For Each Sht In ActiveWorkbook.Sheets
For Each Cht In Sht.ChartObjects
Cht.Chart.ChartArea.Font.Size = 9
Cht.Chart.ChartArea.Font.Name = "Cambria"
Cht.Chart.ChartArea.Border.LineStyle = xlNone
Cht.Chart.Axes(xlValue).MinimumScale = 0
Cht.Chart.Axes(xlCategory).MinimumScale = Range("B4").Value
Cht.Chart.Axes(xlCategory).MaximumScale = Range("B15").Value
Next Cht
Next Sht
End Sub
If the min and max are always within the range B14:B15 on Sht you can use:
Cht.Chart.Axes(xlCategory).MinimumScale = worksheetfunction.Min(Sht.Range("B4:B15"))
Cht.Chart.Axes(xlCategory).MaximumScale = worksheetfunction.Max(Sht.Range("B4:B15"))
Try using the WorksheetFunction.Min for this.
Cht.Chart.Axes(xlCategory).MinimumScale = WorksheetFunction.Min(Columns(2))
Cht.Chart.Axes(xlCategory).MaximumScale = WorksheetFunction.Max(Columns(2))
This assumes the x-axis values are in column 2.
You could add a dim count as long and put your min / max values in adjacent columns. Then increment your count in your For each loop and use Cells([row], [n+] count).value to get the cell value.
By the way, You can use:
With cht.Chart
[...]
End with
Try to use the With Cht.Chart statement, it will shorten and clear your coding style.
When looking for the Min and Max values in Column B, you need to make sure you fully qualify the Range, by adding Sht.Range.
Code
Sub Resize_Fonts()
Dim Sht As Worksheet
Dim Cht As ChartObject
For Each Sht In ActiveWorkbook.Sheets
For Each Cht In Sht.ChartObjects
With Cht.Chart
.ChartArea.Font.SIZE = 9
.ChartArea.Font.Name = "Cambria"
.cartArea.Border.LineStyle = xlNone
.Axes(xlValue).MinimumScale = 0
.Axes(xlCategory).MinimumScale = WorksheetFunction.Min(Sht.Range("B1:B" & Sht.Cells(Sht.Rows.Count, "B").End(xlUp).Row))
.Axes(xlCategory).MaximumScale = WorksheetFunction.Max(Sht.Range("B1:B" & Sht.Cells(Sht.Rows.Count, "B").End(xlUp).Row))
End With
Next Cht
Next Sht
End Sub
After reading your comments, as I first said with my other unregistered account, you can use this method:
Sub Resize_Fonts()
Dim Sht As Worksheet
Dim Cht As ChartObject
Dim count as Long
count = 2 ' For column B
For Each Sht In ActiveWorkbook.Sheets
For Each Cht In Sht.ChartObjects
With Cht.Chart
.ChartArea.Font.Size = 9
.ChartArea.Font.Name = "Cambria"
.ChartArea.Border.LineStyle = xlNone
.Axes(xlValue).MinimumScale = 0
.Axes(xlCategory).MinimumScale = Sht.Cells(4, count).Value
.Axes(xlCategory).MaximumScale = Sht.Cells(15, count).Value
End with
count = count + n ' with n your "pattern"
Next Cht
count = 2 ' reset the count when changing sheet
Next Sht
End Sub
This assume values are always row 4 and row 15.
Comment if you have any other queries