These are two different codes I am using to generate chart and do the calculation using two different buttons.
Code1: To generate charts, works okay
Private Sub CommandButton1_Click()
'PURPOSE: Create a chart (chart dimensions are required)
Dim rng As Range
Dim cht As ChartObject
'Your data range for the chart
Set rng = ActiveSheet.Range("A27:B113")
'Create a chart
Set cht = ActiveSheet.ChartObjects.Add( _
Left:=ActiveCell.Left, _
Width:=650, _
Top:=ActiveCell.Top, _
Height:=250)
'Give chart some data
cht.Chart.SetSourceData Source:=rng
'Determine the chart type
cht.Chart.ChartType = xlColumnClustered
End Sub
Code 2: To do the calculations
Sub GenerateCharts()
[D32].Value = "AA"
Range("D31").Formula = Application.WorksheetFunction.SumIf(Range("B27:B113"), ">=56") / Application.WorksheetFunction.Sum(Range("B27:B113"))
[H35].Value = "All Defects"
Range("I35").Formula = "=SUM(B27:B113)"
[H36].Value = "Percentage(%)"
Range("I36").Formula = "=(1-(I28/I29))*100"
[H28].Value = "Non Kaizens"
**Range("I28").Formula = Application.WorksheetFunction.SumIf(Range("'Machine 4th QTR’!V:V", "'Machine 4th QTR'!B:B","", "'Machine 4th QTR’!V:V'"), "<56"**)
End Sub
I have got two issues here.
1. Code 1 runs fine, coming to Code 2, all it does is it calculates the values.
When I run the Code 2, error is shown in the part in BOLD. The BOLD part translates the formula shown below into VBA code.
=SUMIFS('Machine 4th QTR'!V:V,'Machine 4th QTR'!B:B,"",'Machine 4th QTR'!V:V,"<56")
This is the error message displayed:
Wrong number of arguments or invalid propert assigment
I cannot figure out what is going wrong in the last piece (highlighted one).
Can I embed both the codes into one so that I can perform both the operations with only one click.
Change "" to """" or TEXT(,) and change "<56" to ""<56"". You need to double up quotes within quoted strings or use an alternative.
If you want the formula in the cell, use a string representing the formula, not an evaluation (aka result) of the WorksheetFunction.SumIfs formula.
You needed a SUMIFS, not a SUMIF.
You were using back-quotes (e.g. ’) not tick quotes (e.g. ') in some places.
Range("D31").Formula = "=SUMIF(B27:B113, "">=56"")/SUM(B27:B113)"
...
Range("I28").Formula = "=SUMIFS('Machine 4th QTR'!V:V, 'Machine 4th QTR'!B:B, TEXT(,), 'Machine 4th QTR'!V:V, ""<56"")"
Related
I'm attempting to get the trend line equation from the first series in my chart to a shape text box placed elsewhere on the worksheet - however, I can only get the textbox to populate correctly when I'm stepping through the code line by line - during run-time it has no effect:
For Each chtObj In ActiveSheet.ChartObjects
Set cht = chtObj.Chart
For Each srs In chtObj.Chart.SeriesCollection
srs.Trendlines(1).DisplayEquation = True 'Display the labels to get the value
ThisWorkbook.Worksheets("MyDataSheet").Shapes(slopetextboxes(k)).TextFrame.Characters.Text = srs.Trendlines(1).DataLabel.Text
srs.Trendlines(1).DisplayEquation = False 'Turn it back off
Exit For
Next srs
k = k + 1 ' for the slope textboxes
Next chtObj
Note that slopetextboxes is an array containing the names of ~6 shape text boxes.
As far as I know there's no way to get the trend line data label without stopping to display it. I've tried storing it in a string first, DoEvents, and turning Application.ScreenUpdating back on, all to no avail. I'm stumped here.
EDIT: It appears that by placing DoEvents after .DisplayEquation = True I'm able to have some of my shapes populate correctly, but not all. Still appears to be some kind of run-time issue.
BOUNTY EDIT: I've moved ahead to grab the slopes with a formula ran into the data itself, but I still don't understand why I can't grab the chart's .DataLabel.Text during run-time. I can grab it when stepping through, not during run-time. It appears to just take the PREVIOUS series slope and place it in the shape (or a cell, it doesn't even matter where the destination is). DoEvents placed in different spots yields different outcomes, so something must be going on.
Updated with better understanding of the bug. This works for me in excel 2016 with multiple changes to the source data (and therefore the slope)
I tried myChart.refresh - didnt work. I tried deleting and then re-adding the entire trendline, also didnt work.
This works for everything but the first case. First case needs to be hit twice. Same as for .select
If you try and delete trendline even after assigning its text to textbox, this wont work
Option Explicit
Sub main()
Dim ws As Worksheet
Dim txtbox As OLEObject
Dim chartObject As chartObject
Dim myChart As chart
Dim myChartSeriesCol As SeriesCollection
Dim myChartSeries As Series
Dim myChartTrendLines As Trendlines
Dim myTrendLine As Trendline
Set ws = Sheets("MyDataSheet")
Set txtbox = ws.OLEObjects("TextBox1")
For Each chartObject In ws.ChartObjects
Set myChart = chartObject.chart
Set myChartSeriesCol = myChart.SeriesCollection
Set myChartSeries = myChartSeriesCol(1)
Set myChartTrendLines = myChartSeries.Trendlines
With myChartTrendLines
If .Count = 0 Then
.Add
End If
End With
Set myTrendLine = myChartTrendLines.Item(1)
With myTrendLine
.DisplayEquation = True
txtbox.Object.Text = .DataLabel.Text
End With
Next chartObject
End Sub
Here's my code that seems to definitely work when just pressing F5:
Basically, I store the text in a collection, then iterate through all of the textboxes to add the text to the textboxes. If this wasn't precisely what you were asking for, then I hope this helps in any way.
Sub getEqus()
Dim ws As Worksheet
Dim cht As Chart
Dim srs As Variant
Dim k As Long
Dim i As Long
Dim equs As New Collection
Dim shp As Shape
Dim slopetextboxes As New Collection
Set ws = Excel.Application.ThisWorkbook.Worksheets(1)
'part of the problem seemed to be how you were defining your shape objects
slopetextboxes.Add ws.Shapes.Range("TextBox 4")
slopetextboxes.Add ws.Shapes.Range("TextBox 5")
For Each chtObj In ActiveSheet.ChartObjects
Set cht = chtObj.Chart
For Each srs In chtObj.Chart.SeriesCollection
srs.Trendlines(1).DisplayEquation = True 'Display the labels to get the value
equs.Add srs.Trendlines(1).DataLabel.Text
srs.Trendlines(1).DisplayEquation = False 'Turn it back off
Next srs
Next chtObj
For i = 1 To slopetextboxes.Count
'test output i was trying
ws.Cells(i + 1, 7).Value = equs(i)
slopetextboxes(i).TextFrame.Characters.Text = equs(i)
Next
End Sub
Pictures of what the output looks like when i just press the button
Good luck!
This worked for me - I loop through multiple charts on Sheet1, toggling DisplayEquation and then writing the equation to a textbox/shape on the different worksheet. I used TextFrame2.TextRange but TextFrame worked as well, if you prefer that. I wrote to both a regular text box, as well as a shape, which was probably overkill as the syntax is the same for both.
This gets the trendline equation from the first Series - it sounded like you didn't want to loop through all the Series in the SeriesCollection.
Sub ExtractEquations()
Dim chtObj As ChartObject
Dim slopeTextBoxes() As Variant
Dim slopeShapes() As Variant
Dim i As Integer
slopeTextBoxes = Array("TextBox 1", "TextBox 2", "TextBox 3")
slopeShapes = Array("Rectangle 6", "Rectangle 7", "Rectangle 8")
For Each chtObj In ThisWorkbook.Sheets("Sheet1").ChartObjects
With chtObj.Chart.SeriesCollection(1).Trendlines(1)
.DisplayEquation = True
ThisWorkbook.Sheets("MyDataSheet").Shapes(slopeTextBoxes(i)).TextFrame2.TextRange.Characters.Text = .DataLabel.Text
ThisWorkbook.Sheets("MyDataSheet").Shapes(slopeShapes(i)).TextFrame2.TextRange.Characters.Text = .DataLabel.Text
.DisplayEquation = False
i = i + 1
End With
Next chtObj
End Sub
I've written this off as a bug - The only workaround was discovered by BrakNicku which is to Select the DataLabel before reading its Text property:
srs.Trendlines(1).DataLabel.Select
Not a sufficient solution (since this can cause some issues during run-time), but the only thing that works.
I had a similar issue running the code below and my solution was to run Application.ScreenUpdating = True between setting the trendline and querying the DataLabel. Note that screen updating was already enabled.
'Set trendline to the formal y = Ae^Bx
NewTrendline.Type = xlExponential
'Display the equation on the chart
NewTrendline.DisplayEquation = True
'Add the R^2 value to the chart
NewTrendline.DisplayRSquared = True
'Increse number of decimal places
NewTrendline.DataLabel.NumberFormat = "#,##0.000000000000000"
'Enable screen updating for the change in format to take effect otherwise FittedEquation = ""
Application.ScreenUpdating = True
'Get the text of the displated equation
FittedEquation = NewTrendline.DataLabel.Text
If it works when you step through, but not when it runs then it's an issue with timing and what Excel is doing in between steps. When you step through, it has time to figure things out and update the screen.
FYI, Application.Screenupdating = False doesn't work when stepping
through code. It gets set back to True wherever the code pauses.
When did you give it a chance to actually do the math and calculate the equation? The answer is that, you didn't; hence why you get the previous formula.
If you add a simple Application.Calculate (in the right spot) I think you'll find that it works just fine.
In addition, why should Excel waste time and update text to an object that isn't visible? The answer is, it shouldn't, and doesn't.
In the interest of minimizing the amount of times you want Excel to calculate, I'd suggest creating two loops.
The first one, to go through each chart and display the equations
Then force Excel to calculate the values
Followed by another loop to get the values and hide the equations again.
' Display the labels on all the Charts
For Each chtObj In ActiveSheet.ChartObjects
Set cht = chtObj.Chart
For Each srs In chtObj.Chart.SeriesCollection
srs.Trendlines(1).DisplayEquation = True 'Display the labels to get the value
' I take issue with the next line
' Why are you creating a loop, just for the first series?
' I hope this is just left over from a real If condition that wan't included for simplicity
Exit For
Next srs
Next chtObj
Application.ScreenUpdating = True
Application.Calculate
Application.ScreenUpdating = False
' Get the Equation and hide the equations on the chart
For Each chtObj In ActiveSheet.ChartObjects
Set cht = chtObj.Chart
For Each srs In chtObj.Chart.SeriesCollection
ThisWorkbook.Worksheets("MyDataSheet").Shapes(slopetextboxes(k)).TextFrame.Characters.Text = srs.Trendlines(1).DataLabel.Text
srs.Trendlines(1).DisplayEquation = False 'Turn it back off
Exit For
Next srs
k = k + 1 ' for the slope textboxes
Next chtObj
Application.ScreenUpdating = True
Update:
I added a sample file based on your description of the issue. You can select 4 different options in an ActiveX ComboBox which copies values to the Y-Values of a chart. It shows the trend-line equation below, based on the formula & through copying the value from the chart into a Textbox shape.
Maybe 2016 is different, but it works perfectly in 2013. Try it out...
Shape Text Box Example.xlsm
I've started to use Macros this weekend (I tend to pick up quickly in regards to computers). So far I've been able to get by with searching for answers when I have questions, but my understanding is so limited I'm to a point where I'm no longer understanding the answers. I am writing a function using VBA for Excel. I'd like the function to result in a range, that can then be used as a variable for another function later. This is the code that I have:
Function StartingCell() As Range
Dim cNum As Integer
Dim R As Integer
Dim C As Variant
C = InputBox("Starting Column:")
R = InputBox("Starting Row:")
cNum = Range(C & 1).Column
Cells(R, cNum).Select
The code up to here works. It selects the cell and all is well in the world.
Set StartingCell = Range(Cell.Address)
End Function
I suppose I have no idea how to save this location as the StartingCell(). I used the same code as I had seen in another very similar situation with the "= Range(Cell.Address)." But that's not working here. Any ideas? Do I need to give more information for help? Thanks for your input!
Edit: I forgot to add that I'm using the InputBox to select the starting cell because I will be reusing this code with multiple data sets and will need to put each data set in a different location, each time this will follow the same population pattern.
Thank you A.S.H & Shai Rado
I've updated the code to:
Function selectQuadrant() As Range
Dim myRange As Range
Set myRange = Application.InputBox(Prompt:="Enter a range: ", Type:=8)
Set selectQuadrant = myRange
End Function
This is working well. (It appears that text is supposed to show "Enter a range:" but it only showed "Input" for the InputBox. Possibly this could be because I'm on a Mac?
Anyhow. I was able to call the function and set it to a new variable in my other code. But I'm doing something similar to set a long (for a color) so I can select cells of a certain color within a range but I'm getting all kinds of Object errors here as well. I really don't understand it. (And I think I'm dealing with more issues because, being on a mac, I don't have the typical window to edit my macros. Just me, basically a text box and the internet.
So. Here also is the Function for the Color and the Sub that is using the functions. (I've edited both so much I'm not sure where I started or where the error is.)
I'm using the functions and setting the variables to equal the function results.
Sub SelectQuadrantAndPlanets()
Dim quadrant As Range
Dim planetColor As Long
Set quadrant = selectQuadrant()
Set planetColor = selectPlanetColor() '<This is the row that highlights as an error
Call selectAllPlanets(quadrant, planetColor)
End Sub
This is the function I'm using to select the color that I want to highlight within my range
I would alternately be ok with using the interior color from a range that I select, but I didn't know how to set the interior color as the variable so instead I went with the 1, 2 or 3 in the input box.
Function selectPlanetColor() As Long
Dim Color As Integer
Color = InputBox("What Color" _
& vbNewLine & "1 = Large Planets" _
& vbNewLine & "2 = Medium Planets" _
& vbNewLine & "3 = Small Planets")
Dim LargePlanet As Long
Dim MediumPLanet As Long
Dim smallPlanet As Long
LargePlanet = 5475797
MediumPlanet = 9620956
smallPlanet = 12893591
If Color = 1 Then
selectPlanetColor = LargePlanet
Else
If Color = 2 Then
selectPlanetColor = MediumPlanet
Else
If Color = 3 Then
selectPlanetColor = smallPlanet
End If
End If
End If
End Function
Any help would be amazing. I've been able to do the pieces individually but now drawing them all together into one sub that calls on them is not working out well for me. Thank you VBA community :)
It's much simpler. Just
Set StartingCell = Cells(R, C)
after getting the inputs, then End Function.
The magic of the Cells method is it accepts, for its second parameter, both a number or a character. That is:
Cells(3, 4) <=> Cells(3, "D")
and
Cells(1, 28) <=> Cells(3, "AB")
One more thing, you can prompt the user directly to enter a range, with just one input box, like this:
Dim myRange as Range
Set myRange = Application.InputBox(Prompt:="Enter a range: ", Type:=8)
The Type:=8 specifies the input prompted for is a Range.
Last thing, since you are in the learning process of VBA, avoid as much as possible:
using the Select and Activate stuff
using unqualified ranges. This refers to anywhere the methods Cells(..) or Range(..) appear without a dot . before them. That usually leads to some random issues, because they refer to the ActiveSheet, which means the behavior of the routine will depend on what is the active worksheet at the moment they run. Avoid this and always refer explicitly from which sheet you define the range.
Continuing your line of thought of selecting the Range bu Selecting the Column and Row using the InputBox, use the Application.InputBox and add the Type at the end to restrict the options of the user to the type you want (Type:= 1 >> String, Type:= 2 >> Number).
Function StartingCell Code
Function StartingCell() As Range
Dim cNum As Integer
Dim R As Integer
Dim C As Variant
C = Application.InputBox(prompt:="Starting Column:", Type:=2) '<-- type 2 inidcates a String
R = Application.InputBox(prompt:="Starting Row:", Type:=1) '<-- type 1 inidcates a Number
Set StartingCell = Range(Cells(R, C), Cells(R, C))
End Function
Sub TestFunc Code (to test the function)
Sub TestFunc()
Dim StartCell As Range
Dim StartCellAddress As String
Set StartCell = StartingCell '<-- set the Range address to a variable (using the function)
StartCellAddress = StartCell.Address '<-- read the Range address to a String
End Sub
I am working with a pie chart and a legend in Excel 2003.
The legend entries are composed of strings like this:
75% Ice Cream
20% Brownies
5% Gummy Bears
I am trying to put the exposure percentage in bold but leave the rest of the series name (Ice Cream, Brownies, or Gummy Bears) in regular font.
Is it possible to do this?
So far I have been working with variations on this code. In addition, I have tried using the Split() function on the SeriesCollection object and even recording a macro to see what Excel would generate in VBA. Thus far I can only get the text to appear in all bold, or all regular font, and not a mix of the two.
For x = 1 To 3
myChartObject.Chart.Legend.LegendEntries(x).Font.Bold = True
Next x
Suggestions would be helpful.
I didn't catch the fact that you're working in a chart, but hopefully the below can help. If you can get the characters, then you can bold certain parts of a string. (Assuming your column A has a cell with 20% Brownies, the next cell 75% Ice Cream, etc.)
Sub boldPercent()
Dim i&, lastRow&, percentLength&, percentAmt$
Dim k&
lastRow = Cells(Rows.Count, 1).End(xlUp).Row ' Assuming your data is in column A
For i = 1 To lastRow
percentAmt = Left(Cells(i, 1), WorksheetFunction.Search("%", Cells(i, 1)))
percentLength = Len(percentAmt)
With Cells(i, 1).Characters(Start:=1, Length:=percentLength)
.Font.Bold = True
End With
Next i
End Sub
So perhaps you can use that and tweak it to work with the chart area? Have VBA loop through your chart titles, and perhaps you can use the same method above.
Edit: I'm making a mock example chart to try and work on this - but how are you getting the percentages of each category into the Legend? I have set up a super simple chart, but don't know where you went from here (screenshot)
(I'm expecting your legend to say 75% Ice Cream, 20% Brownies, etc. right?)
Edit2: Okay, I have moved into using the Chart object, hoping to grab each Legend Entry, and would feather in the bolding of characters as I did above...however, I can't get legendStringever to be a non-empty string:
Sub Bold_Legend_Text()
Dim stringToFind$
Dim cObj As ChartObject
Dim legEnt As LegendEntry
Dim cht As Chart
Dim i&
Dim percentLength&
Dim legendString$
stringToFind = "%"
For Each cObj In ActiveSheet.ChartObjects
Set cht = cObj.Chart
With cht
If .HasLegend Then
Debug.Print .Legend.LegendEntries.Count
For Each legEnt In .Legend.LegendEntries
' This always returns an empty string, not sure why!
legendString = legEnt.Format.TextFrame2.TextRange.Characters.Text
Debug.Print legendString
' Then we'd find where "%" shows up in the Legend title, and try to bold
' just certain characters
Next legEnt
End If
Next cObj
End Sub
(Thanks to this thread)
Thought provoking problem (for me at least). Normally when creating a chart you have your data and then use it to create the chart. If you then copy the chart to another workbook, the values on the chart stay the same but there is "no available" data source in the new workbook. I want to create a new chart which is the average of multiple copied charts. Is this possible in excel/vba?
I can't even try recording a macro and going from there as I don't know if its possible to "average" multiple charts.
EDIT : Been doing some more thinking and am thinking if it is possible to instead of extract data into a new sheet for each chart, is it possible to average data upon extraction. If on the chart you Right click -> select data, you can see the reference to the data in the original worksheet. Is it possible to average this and print just the outcome without having to store all the data? Would still be easier to directly average charts if possible!
EDIT 2: I have reworked my data template so that matching time series data ranges is no longer an issue. Also as per the comment on averages-of-averages, the data is all of equal weight and quantity so this should not be a problem. It literally just comes down to: is there a way to take the face values of multiple charts (or graphs), and average them to form a new chart (or graph) without massive data manipulation in the original (or new) workbook?
Bounty Summary (with round numbers): Looking for a quick'ish way in VBA to create a chart which is the average of multiple charts. I have 10 types of chart on 50 separate worksheets. I'm looking to create a summary sheet with 10 charts that average the data from the same respective chart on the other 50 sheets. The key difficulty is that this is a 'presentation Workbook that all charts are copied into, all the data for each chart is in a different workbook.
EDIT 4: Data is stored in multiple time series tables that are all side by side in a main data sheet. It appears to be at the moment (as per Scott's comment) that there is no way to directly manipulate and the most likely solution will be that of data extraction/manipulation. Search still continues though :)
I want to create a new chart which is the average of multiple copied charts. Is this possible in excel/vba?
It is possible but there is no magic formula for this task.
I would first iterate each workbook, each worksheet, each shape and aggregate the values in an array, with one array for each type of chart.
To avoid storing all the data, the averages will have to be computed upon each extraction like this:
Average = ((PreviousAverage * N) + Value) / (N + 1)
Next, to expose the data in your dashboard, I would duplicate the missing charts from the aggregated workbooks and reuse the one already present.
This way, the customisation of the dashboard will remain untouched if all the charts are already there.
Finally, I would directly insert the aggregated values in the charts without storing them in a sheet.
I've assemble a working example that aggregates all the charts from the current workbook and displays the results in the sheet "Dashboard":
Sub AgregateCharts()
Dim ws As Worksheet, wsDashboard As Worksheet, sh As Shape, ch As chart
Dim xValues(), yValues(), yAverages(), weight&, key
Dim items As Scripting.dictionary, item As Scripting.dictionary
Set items = CreateObject("Scripting.Dictionary")
' define the dashboard sheet
Set wsDashboard = ThisWorkbook.sheets("Dashboard")
' disable events
Application.ScreenUpdating = False
Application.EnableEvents = False
' iterate worksheets '
For Each ws In ThisWorkbook.Worksheets
' if not dashboard '
If Not ws Is wsDashboard Then
' iterate shapes '
For Each sh In ws.Shapes
If sh.type = msoChart Then ' if type is chart '
Debug.Print "Agregate " & ws.name & "!" & sh.name
' check if that type of chart was previously handled
If Not items.Exists(sh.chart.chartType) Then
' extract the values from the first serie
xValues = sh.chart.SeriesCollection(1).xValues
yValues = sh.chart.SeriesCollection(1).values
' duplicate the chart if it doesn't exists in the dashboard
Set ch = FindChart(wsDashboard, sh.chart.chartType)
If ch Is Nothing Then
Set ch = DuplicateChart(sh.chart, wsDashboard)
End If
' store the data in a new item '
Set item = New Scripting.dictionary
item.Add "Chart", ch
item.Add "Weight", 1 ' number of charts used to compute the averages
item.Add "XValues", xValues
item.Add "YAverages", yValues
items.Add ch.chartType, item ' add the item to the collection '
Else
' retreive the item for the type of chart '
Set item = items(sh.chart.chartType)
weight = item("Weight")
yAverages = item("YAverages")
' update the averages : ((previous * count) + value) / (count + 1) '
yValues = sh.chart.SeriesCollection(1).values
UpdateAverages yAverages, weight, yValues
' save the results '
item("YAverages") = yAverages
item("Weight") = weight + 1
End If
End If
Next
End If
Next
' Fill the data for each chart in the dashboard
For Each key In items
Set item = items(key)
Set ch = item("Chart")
' Add the computed averages to the chart
ch.SeriesCollection(1).xValues = "={" & Join(item("XValues"), ";") & "}"
ch.SeriesCollection(1).values = "={" & Join(item("YAverages"), ";") & "}"
Next
' restore events
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Private Sub UpdateAverages(averages(), weight&, values())
Dim i&
For i = LBound(averages) To UBound(averages)
averages(i) = (averages(i) * weight + values(i)) / (weight + 1)
Next
End Sub
Private Function DuplicateChart(ByVal source As chart, target As Worksheet) As chart
' clone the chart to the target
source.Parent.Copy
target.Paste
Application.CutCopyMode = 0
' clear the data '
With target.Shapes(target.Shapes.count).chart.SeriesCollection(1)
Set DuplicateChart = .Parent.Parent
.name = CStr(.name)
.xValues = "={0}"
.values = "={0}"
End With
End Function
Private Function FindChart(source As Worksheet, chartType As XlChartType) As chart
' iterate each shape in the worksheet to fin the corresponding type
Dim sh As Shape
For Each sh In source.Shapes
If sh.type = msoChart Then
If sh.chart.chartType = chartType Then
Set FindChart = sh.chart
Exit Function
End If
End If
Next
End Function
Some data manipulation will probably be necessary. However, you can do it all in memory (or in a hidden worksheet if you prefer).
To extract data from a chart, example code:
Sub chartTest()
Dim ch As ChartObject
Set ch = Worksheets(1).ChartObjects(1)
Dim nr As Variant, var As Variant, var 2 As Variant
nr = UBound(ch.Chart.SeriesCollection(1).Values)
' Paste the values back onto the sheet
Range(Cells(1, 1), Cells(nr, 1)) = Application.Transpose(ch.Chart.SeriesCollection(1).XValues)
Range(Cells(1, 2), Cells(nr, 2)) = Application.Transpose(ch.Chart.SeriesCollection(1).Values)
' Pull the values into a variable (will be in array format)
var = ch.Chart.SeriesCollection(1).XValues
var2 = ch.Chart.SeriesCollection(1).Values
' Retrieval example
For i = 1 To UBound(var)
Range("A" & i).Value = var(i)
Range("B" & i).Value = var2(i)
Next i
End Sub
Whether you use Chart or ChartObjects as a first stop seems to depend on how the chart is created. The code in this example worked for a chart created by right-clicking some data in a sheet and inserting the chart.
See the Chart.SeriesCollection and the Series Properties pages on MSDN for more information.
So basically, extract all the data from the charts using code similar to the above, compare them, and create a new chart based on this data.
I have data in excel sheet like this
Country Product Price
America A 43
China B 13
Germany C 21
Turkey D 12
In excel i select this data and make a chart out of it that seems like this
But the problem is when i select the same data with vba and draw the chart from vba then it results into
Now i want the vba chart to display to category axis as same as we select data from excel and draw the chart.
In short i want the vba chart to automatically adjust according to the data.
Here is the code.
Sub CreateChart()
Range("a1").Select
Selection.CurrentRegion.Select
myrange = Selection.Address
mysheetname = ActiveSheet.Name
Worksheets(1).Activate
'ActiveWindow.DisplayGridlines = False
' Add a chart to the active sheet.
ActiveSheet.ChartObjects.Add(125.25, 60, 301.5, 155.25).Select
Application.CutCopyMode = False
ActiveChart.ChartWizard _
Source:=Sheets(mysheetname).Range(myrange), _
Gallery:=xlColumnStacked, Format:=10, PlotBy:=xlRows, _
CategoryLabels:=1, SeriesLabels:=1, HasLegend:=1, _
Title:=charttitle, CategoryTitle:=chartcategory, _
ValueTitle:=chartvalue, ExtraTitle:=""
End Sub
It's very simple in Excel. Record a macro while inserting the chart and selecting the data for the chart. The recorder records the VBA steps and gives you the neat code which can do the same whenever you execute. For instance, the recorder gave me this 2 lines of code:
Sub Macro1()
ActiveSheet.Shapes.AddChart2(201, xlColumnClustered).Select
ActiveChart.SetSourceData Source:=Range("A2:C5"), PlotBy:=xlColumns
End Sub
Pretty simple, isn't it?
If you just wana to update data in already existing chart, better solution can be to update them. Basicaly create chart which you desire and assign some name to it. (for example myLovelyChart)
Sub updateChartSO()
Dim chartSheet As Worksheet
Set chartSheet = Sheets("testSheet")
Dim chtSerie As Series
With chartSheet
For Each chtSerie In .ChartObjects("myLovelyChart").SeriesCollection
'specify your values, can be specified by array or even from sheet'
chtSerie.Values = ""
chtSerie.XValues = ""
Next
End With
End Sub
Or if you really wana to create new chart, take a closer look at chartType property (https://msdn.microsoft.com/en-us/library/office/ff820803.aspx) and its enumeration (https://msdn.microsoft.com/en-us/library/office/ff838409.aspx)
In VBA, it auto define the format based on data range.
However, You can using below code to control it
Chart(1).PlotBy = xlRows
OR
Chart(1).PlotBy = xlColumns