Excel VBA - Get chart data range - excel

I want to add data to a bunch of existing charts. Assume that each chart has a different number of data series and that the location of the raw data is somewhere in the same workbook. Here's what I'm starting with:
For iChart = 1 To iCount
ActiveSheet.ChartObjects("Chart " & iChart).Activate
intSeries = 1
Do Until ActiveChart.SeriesCollection(intSeries).Name = ""
Set rXVal = ActiveChart.SeriesCollection(intSeries).XValues '<- Object Required error
Set rXVal = Range(rXVal, rXVal.End(xlDown))
Set rYVal = ActiveChart.SeriesCollection(intSeries).Values
Set rYVal = Range(rYVal, rYVal.End(xlDown))
ActiveChart.SeriesCollection(intSeries).XValues = rXVal
ActiveChart.SeriesCollection(intSeries).Values = rYVal
intSeries = intSeries + 1
Loop
Next iChart
I know that ActiveChart...XValues = rXVal works, but I'm getting an "Object Required" error on the Set rXVal = ActiveChart....XValues line. I'm assuming that since a range went in to define the data series, I can get that range back out again and then add to it.
UPDATE
To clarify things a little, I have accelerometers in 8 places and FFT software setup to record peak vibration response in 4 separate frequency bands. This yields 32 data points per sample. When exporting, the software spits out an Excel workbook with 4 sheets; one for each frequency band. Each sheet has the accelerometer names going across and sample numbers going down.

I have succeeded using this syntax:
Dim rXVal() As Variant
rXVal = ActiveChart.SeriesCollection(intSeries).XValues
UPDATE
In this case you get an array, because your given statement (ActiveChart.SeriesCollection(intSeries).XValues) is an array and not a range. This is what you see in Locals window if you dig into Series object of ActiveChart.SeriesCollection(intSeries):
(in my dummy data I have rows named r1, r2, r3, r4.)
What I want to say, XValues does not have any property which would indicate its occupied range.
If you actually need a range, I would suggest getting it from the formula property. And the way I would suggest is replacing your error causing line with this one:
Set rXVal = Range(Split(ActiveChart.SeriesCollection(intSeries).Formula, ",")(1))
Next, I see you trying to get the range for Values. Similarly, use this:
Set rYVal = Range(Split(ActiveChart.SeriesCollection(intSeries).Formula, ",")(2))
Another thing.
The following lines will cause you an error finally:
intSeries = 1
Do Until ActiveChart.SeriesCollection(intSeries).Name = ""
...some code...
intSeries = intSeries + 1
Loop
Do change them with:
For intSeries = 1 To ActiveChart.SeriesCollection.Count
...some code...
Next
Yet another thing.
Consider using With and End With, as you repeat a lot ActiveChart.SeriesCollection(intSeries). Then your code will be much more readable, as you would just skip this long line! Wouldn't that be awesome???

This works fine for me:
Dim rXVal() As Variant
Dim rXValMin, rXValMax As Double
rXVal = ActiveChart.SeriesCollection(intSeries).XValues
rXValMin = WorksheetFunction.Min(rXVal)
rXValMax = WorksheetFunction.Max(rXVal)

Related

Excel VBA graph based on Series not working properly

I'm using the following VBA code in Excel in order to produce 2 graphs with a data picked up from the sheet and slightly elaborated. As I'm not using ranges directly for the graphs and need to use arrays for X and Y axes, I decided to go for Series. X has Date type and Y has Integer type. First it worked, but then the graphs started giving me wrong data, something random coming directly off the sheet. I suppose there could be something wrong in the way how the charts are declared. Here's the code, what could go wrong with it?
Dim crt1, crt2 As Chart
Dim sr1, sr2 As Series
ActiveSheet.Shapes.AddChart2(201, xlColumnClustered, 60, 50).Select
Set crt1 = ActiveChart
Set s1 = crt1.SeriesCollection.NewSeries()
sr1.Values = dataArray1
sr1.XValues = datesArray1
ActiveSheet.Shapes.AddChart2(332, xlLineMarkers).Select
Set crt2 = ActiveChart
Set s2 = crt2.SeriesCollection.NewSeries()
sr2.Values = dataArray2
sr2.XValues = datesArray2
This problem also persists when I comment the code for the second graph.
P.S. Excel says "Runtime error 424. Object required" underlining "sr1.Values = dataArray1" and then "sr1.XValues = datesArray1"

How to loop through XML-nodes and validate if values exists?

I have through an API fetched my data as an XML, and I wish to cycle through nodes (there are several of the same type) and add them to certain fields/a table.
Example from the XML-file:
<HistRating
xmlns="">
<EndrAr>2020</EndrAr>
<EndrMnd>7</EndrMnd>
<Rating>A</Rating>
</HistRating>
<HistRating
xmlns="">
<EndrAr>2019</EndrAr>
<EndrMnd>6</EndrMnd>
<Rating>A</Rating>
</HistRating>
I have tried the following format (at this point the XML I need is in a string in xmlDoc xmlDoc = CreateObject("MSXML2.DOMDocument.6.0"). Fully aware that this is not a really "sexy" way to write it, but I'm new at this game:
Set nodeXML = xmlDoc.getElementsByTagName("EndrAr")
Range("G1").Value = nodeXML(1).Text
Range("H1").Value = nodeXML(2).Text
Range("I1").Value = nodeXML(3).Text
Set nodeXML = xmlDoc.getElementsByTagName("EndrMnd")
Range("G2").Value = nodeXML(1).Text
Range("H2").Value = nodeXML(2).Text
Range("I2").Value = nodeXML(3).Text
Set nodeXML = xmlDoc.getElementsByTagName("Rating")
Range("G3").Value = nodeXML(1).Text
Range("H3").Value = nodeXML(2).Text
Range("I3").Value = nodeXML(3).Text
This works great as long as all three items are there. Unfortunately that is not given. If it is a new company i.e. (3) wont exist (there is one line per year above), and I would like to either set the cell to Blank or No value or something.
The result from when I run the above code:
But if I try to add a line 4 to test what happens if value does not exists I get the following (for obvious reasons)
What I would love some help with is:
Can I by some "magic" add a ifmissing (tried it, but could not get it to work)?
Other ways to add a if variable is not found, input following into cell
Or are there a complete different way I should have solved this?
This is to add accounting data from last X available years (where X is ie 4, or less if not 4 is available) from 30 nodes.
You could use an Error trapping Function. Note in the code below we choose not to use the returned boolean.
Dim myTest as String
.
.
TryReadingXmlNode nodeXML,1, myText
Range("G1").Value = myText
.
.
Public Function TryReadingXmlNode(ByVal ipNode as object, ByVal ipIndex as Long, ByRef opText as string) as boolean
On Error Resume Next
opText=ipNode.Item(ipIndex).Text
TryReadingXmlNode=Len(opText)>0
If err.number>0 then opText="NoValue"
on Error Goto 0
End Function
Start by querying all of the HistRating elements, then loop over that collection:
Const MAX_YEARS As Long = 4
Dim ratings, rating, c As Range, i as Long
Set c= Range("A1")
Set ratings = xmlDoc.getElementsByTagName("HistRating")
For Each rating in ratings
c.offset(0, i) = rating.getElementsByTagName("EndrAr")(0).Text
c.offset(1, i) = rating.getElementsByTagName("EndrMnd")(0).Text
c.offset(2, i) = rating.getElementsByTagName("Rating")(0).Text
i = i + 1
If i >= MAX_YEARS Then Exit For 'exit if processed enough nodes
Next rating

Update an Excel style in VBA

My Excel macro reads the answers to a survey from a set of Excel files. The answers of a survey contain a score (from 1 to 4) and a description. The goal is to generate a a matrix. Each cell of the matrix has a color that represents the score. I would like the user to be able to modify the layout of these cell. To make it easy to the user, I created a template matrix and a button. The user should be able to modify the layout of the cells and on a click of a button, a set of styles (Score 1, Score 2,...) should be generated. Once the matrix is created, the Workbook should be to function without the survey files.
I have tried a couple of things:
Try 1
ThisWorkbook.Styles.Add "Score 1", BasedOn:=cell1
This gives errors. I don't fully understand when they occur, but one of the causes is when the user modifies the cell layout by selecting another style.
Try 2
ThisWorkbook.Styles("Score 1").Delete
ThisWorkbook.Styles.Add "Score 1", BasedOn:=cell1
This is not a good idea: all cells loose their styling when it is executed a second time.
Try 3: Current
Copy the most frequently used properties of the cells layout and copy them to the style. If this style is deleted by the user, it is recreated. This procedures is not ideal, since most style properties won't be covered.
Is there a way to update a cell style that is more general? I would like there to be as little room as possible to make the workbook in an inconsistent and non-functional state.
I sticked with try 3. Because it required a lot of code for all properties that seemed possible to be edited, and because of copying borders is tricky, I post the result.
'xR1_Template: the cell to base the style on
'nm_Style: the name of the style
Public Function Upsert_Style(xR1_Template As Excel.Range, nm_Style As String) As Excel.Style
Dim xStyle As Excel.Style
Set xStyle = Fn.TryGet(ThisWorkbook.Styles, nm_Style)
If Fn.IsNothing(xStyle) Then
Set xStyle = ThisWorkbook.Styles.Add(nm_Style)
End If
xStyle.Font.Color = xR1_Template.Font.Color
xStyle.Font.Bold = xR1_Template.Font.Bold
xStyle.Font.Name = xR1_Template.Font.Name
xStyle.Font.Italic = xR1_Template.Font.Italic
xStyle.Font.Size = xR1_Template.Font.Size
xStyle.Font.Strikethrough = xR1_Template.Font.Strikethrough
xStyle.Font.Subscript = xR1_Template.Font.Subscript
xStyle.Font.Superscript = xR1_Template.Font.Superscript
xStyle.Font.Underline = xR1_Template.Font.Underline
xStyle.Interior.Color = xR1_Template.Interior.Color
xStyle.Interior.Pattern = xR1_Template.Interior.Pattern
xStyle.Interior.PatternColor = xR1_Template.Interior.PatternColor
'NOTE: necessary to delete all borders first. There's no way to delete them one by one.
xStyle.Borders.LineStyle = xlNone
Dim iBorder As Long
For iBorder = 1 To xR1_Template.Borders.Count
Dim xBorder As Excel.Border
'NOTE: The Borders property claims to work with xlBordersIndex argument, but this is not true.
' Normal indexing is used.
Set xBorder = xR1_Template.Borders(iBorder)
'NOTE: "none-style" borders (=no border), should be skipped.
' Once they are retrieved using the Borders property, they are always visible.
' Setting them with xlLineStyle.xlLineStyleNone does not hide them.
If xBorder.LineStyle <> XlLineStyle.xlLineStyleNone Then
Dim xBorder_Style As Excel.Border
Set xBorder_Style = xStyle.Borders(iBorder)
xBorder_Style.Color = xBorder.Color
xBorder_Style.LineStyle = xBorder.LineStyle
xBorder_Style.Weight = xBorder.Weight
End If
Next iBorder
xStyle.AddIndent = xR1_Template.AddIndent
xStyle.FormulaHidden = xR1_Template.FormulaHidden
xStyle.HorizontalAlignment = xR1_Template.HorizontalAlignment
xStyle.IndentLevel = xR1_Template.IndentLevel
xStyle.NumberFormat = xR1_Template.NumberFormat
xStyle.NumberFormatLocal = xR1_Template.NumberFormatLocal
xStyle.Orientation = xR1_Template.Orientation
xStyle.ShrinkToFit = xR1_Template.ShrinkToFit
xStyle.VerticalAlignment = xR1_Template.VerticalAlignment
xStyle.WrapText = xR1_Template.WrapText
xStyle.IndentLevel = xR1_Template.IndentLevel
Set Upsert_Style = xStyle
End Function

Utilizing a while loop to create combo boxes within Excel Spreadsheet

I need combo boxes to be placed in specific positions in relation to the cells on this Worksheet. I was attempting to utilize a while loop to change a variables value and utilize that variable to dynamic change a cell. However, my code doesn't seem to be working. The loop will run through once, but will give me a "object does not support this property or method" error on the successive loop.
Dim t As Integer
Dim wotype as object
t = 1
Do While t < 43
wotype = ActiveSheet.Shapes.AddFormControl(xlDropDown, Left:=Cells(4, t).Left, Top:=Cells(3, t).Top, Width:=25.29, Height:=Rows(3).RowHeight)
t = t + 3
Loop
When assigning an object to a variable, you need to use the Set keyword...
set wotype = ActiveSheet.Shapes.AddFormControl(xlDropDown, Left:=Cells(4, t).Left, Top:=Cells(3, t).Top, Width:=25.29, Height:=Rows(3).RowHeight)
Although, in this case, since you're not subsequently referring to your variable, your code can be re-written as follows...
Dim t As Integer
t = 1
Do While t < 43
ActiveSheet.Shapes.AddFormControl xlDropDown, Left:=Cells(4, t).Left, Top:=Cells(3, t).Top, Width:=25.29, Height:=Rows(3).RowHeight
t = t + 3
Loop

LibreOffice Basic Ignoring “some” of my Type...End Type Definition

I'm using LibreOffice Version: 4.4.3.2 Build ID: 40m0(Build:2) Locale: en_AU
I have a Basic Module
At the top of this module before any sub or functions I have
Type InitHeadings
MySort_By As Integer
MyCharacter As Integer
MyInitiative As Integer
MyRolled As Integer
MyTotal As Integer
End Type
...
Global InitiativeColumn As New InitHeadings
But when I run a sub, set a breakpoint and 'watch' the InitiativeColumn Object only the first two fields are shown.
The rest of my code relevant to this struct as the documentation calls them is below. I don't reference it anywhere else. Can anyone tell me why the first two would work but not the rest? I have two other structs in this code and both also ignore the last three fields. Is this a Bug?
Sub Main
'Initialise Doc and Sheet Objects
Dim Doc As Object
Doc = ThisComponent
StatsSheet = Doc.Sheets.getByName("Stats")
InitiativeSheet = Doc.Sheets.getByName("Initiative")
CombatSheet = Doc.Sheets.getByName("Combat")
'LOAD HEADING NAMES
'Initiative Sheet
For Column = 0 to 25 'Columns A to Z
MyHeadingName = InitiativeSheet.getCellByPosition(Column,0).String
Select Case MyHeadingName
Case "Sort By"
InitiativeColumn.MySort_By = Column
Case "Character"
InitiativeColumn.MyCharacter = Column
Case "Initiative"
InitiativeColumn.MyInitiative = Column
Case "Rolled"
InitiativeColumn.MyRolled = Column
Case "Total"
InitiativeColumn.MyTotal = Column
End Select
Next Column
End Sub
Sub MyInitiativeButton
'Iterate over a range of cells:
For Row = 1 To 25 'Rows 2 to 26
'Column 3 is column D the "Rolled" column
InitiativeSheet.getCellByPosition(InitiativeColumn.MyRolled,Row).VALUE = Roledice(1,20,0)
Next Row
End Sub
It looks like a bug, and seems to have been reported here. The problem did not occur when I tested it in a newer version (LO 5.1.0.3).
This is only an issue for the debugger window. The values are still there:
Sub TestStructs
InitiativeColumn.MySort_By = 5
InitiativeColumn.MyCharacter = 5
InitiativeColumn.MyTotal = 5
InitiativeColumn.DoesntExist = 5
End Sub
This code works fine until the line InitiativeColumn.DoesntExist = 5, whereupon it crashes.
Now the Global problem that you mentioned in the comments is really a problem. Considering the standard programming advice that global variables are bad, I think it's wise to consider alternatives.
Instead of a subroutine, could you perhaps use a Function that returns InitiativeColumn? If not, then assigning the variable as you suggested seems a viable workaround. Personally for LO macros I prefer Python or Java since they have classes.

Resources