VBA rounding up to the nearest 1E-n - excel

I have created a Scatter Chart using VBA in excel.
The Y-Axis has a logarithmic scaling, as the values in my data ranges (300 data ranges with a few hundred thousand data points in each one) vary from 1 to 1E-10.
Is there a way to scale the Y axis automatically? As the maximum value can vary from chart to chart from 1 to 1E-5.
If not is there a way to round up to the nearest 1E-n? So I can scale my graph using the code below.
MyChart.Axes(xlValue).MaximumScale = "round up max value from my data range"
Thanks in advance
Charlie
For cond = 2 To wb.Worksheets.Count
Set ws = wb.Sheets(cond)
wsn = ws.Name
With ws
'Includes "Title" cell
Set ttl = .Cells(.Columns(1).Find(what:="Title", after:=Cells(1, 1)).Row, 1)
Set ttl2 = .Cells(ttl.Row, .UsedRange.Columns.Count)
Set rng1 = .Range(ttl, ttl2)
Set Data = .Cells(.Columns(1).Find(what:="*Pa)*", after:=Cells(1, 1)).Row + 2, 1)
Set Data2 = .Cells(.UsedRange.Rows.Count, .UsedRange.Columns.Count)
Set rng2 = .Range(Data, Data2)
myrng = Union(rng1, rng2).Address
End With
ws.Shapes.AddChart.Name = (wsn)
ws.Shapes(wsn).Chart.ChartType = xlXYScatterLinesNoMarkers
Set MyChart = ws.Shapes(wsn).Chart
MyChart.SetSourceData Source:=ws.Range(myrng), PlotBy:=xlColumns
MyChart.ApplyLayout (1)
MyChart.ChartTitle.Text = Title & " " & wsn
MyChart.Axes(xlValue, xlPrimary).AxisTitle.Text = "Pressure "
MyChart.Axes(xlCategory, xlPrimary).AxisTitle.Text = "Output”
MyChart.Axes(xlValue).ScaleType = xlLogarithmic
MyChart.Axes(xlValue).TickLabels.NumberFormat = "0.0E+00"
MyChart.Axes(xlValue).CrossesAt = 0.000000001
MyChart.Axes(xlValue).MaximumScale = “needs automating”
MyChart.Axes(xlCategory).ScaleType = xlLogarithmic
MyChart.Axes(xlCategory).MaximumScale = 10000
ws.ChartObjects(wsn).Left = ws.Range("A1").Left
ws.ChartObjects(wsn).Top = ws.Range("A1").Top
ws.ChartObjects(wsn).Height = 400
ws.ChartObjects(wsn).Width = 1200
MyChart.Axes(xlCategory, xlPrimary).HasMajorGridlines = True
MyChart.Axes(xlCategory, xlPrimary).HasMinorGridlines = True
ws.ChartObjects(wsn).Chart.Legend.Left = 1000
ws.ChartObjects(wsn).Chart.Legend.Width = 190
ws.ChartObjects(wsn).Chart.Legend.Top = 17.5
ws.ChartObjects(wsn).Chart.Legend.Height = 360
ws.ChartObjects(wsn).Chart.PlotArea.Width = 975
Next cond

I haven't tried this, but what about:
With MyChart.Axes(xlValue)
.MinimumScaleIsAuto = True
.MaximumScaleIsAuto = True
End With

Related

spacing between Tables in word document

' Set wrdTable1 = objDoc.Tables.Add(objDoc.Range, 20, 2)
Set wrdTable1 = objDoc.Tables.Add(Range:=objWord.Selection.Range, NumRows:=20, NumColumns:=2, _
DefaulttableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitFixed)
wrdTable1.Borders.Enable = False
With wrdTable1.Rows(1)
.Cells(1).Range.Text = "Tele: ####"
.Cells(1).Range.ParagraphFormat.Alignment = wdAlignParagraphLeft
.Cells(2).Range.Text = "!##########"
.Cells(2).Range.ParagraphFormat.Alignment = wdAlignParagraphLeft
End With
wrdTable1.Rows(2).Cells(2).Range.Text = "PIN- 9#####"
wrdTable1.Rows(3).Cells(2).Range.Text = "##########"
wrdTable1.Rows(20).Cells.Merge
wrdTable1.Rows(20).Cells(1).Range.Text = "2. It is under ref :-"
wrdTable1.Rows(20).Cells(1).Range.ParagraphFormat.Alignment = wdAlignParagraphJustify
wrdTable1.Range.InsertParagraphAfter
Set wrdTable2 = objDoc.Tables.Add(wrdTable1.Range.Next, ntotalRecords, ntotalColumns)
Dim intRow As Integer
Dim intCol As Integer
With wrdTable2
intCtr = 1: intRow = 1
While (Sheets("SummaryDVBan").Cells(intCtr, 11).FormulaR1C1 <> "")
For intCol = 1 To ntotalColumns
.cell(intRow, intCol).Range.InsertAfter Sheets("SummaryDVBan").Cells(intCtr, intCol + 10).FormulaR1C1
Next intCol
intCtr = intCtr + 1
intRow = intRow + 1
Wend
.Columns(1).SetWidth 40, wdAdjustFirstColumn
.Columns(2).SetWidth 120, wdAdjustFirstColumn
.Columns(3).SetWidth 60, wdAdjustFirstColumn
.Columns(4).SetWidth 90, wdAdjustFirstColumn
.Columns(5).SetWidth 65, wdAdjustFirstColumn
.Columns(6).SetWidth 60, wdAdjustFirstColumn
.Columns(7).SetWidth 90, wdAdjustFirstColumn
.Style = "Table Grid"
.Borders.Enable = True
.Rows(1).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
.Rows(1).Range.Bold = True
.Rows(1).HeadingFormat = True
.Range.ParagraphFormat.Alignment = wdAlignParagraphJustify
.Borders.InsideLineStyle = wdLineStyleSingle
End With
wrdTable2.Range.InsertParagraphAfter
Set wrdTable3 = objDoc.Tables.Add(wrdTable2.Range.Next, 7, 4) ' insert table 3
wrdTable3.Borders.Enable = False
w = wrdTable3.Rows(1).Cells(1).Width * 4
w1 = w * 0.26
For X = 1 To 7
With wrdTable3.Rows(X)
.Cells(1).Width = w1
.Cells(2).Width = w1
.Cells(3).Width = w1
.Cells(4).Width = w1
.Height = 16
End With
Next X
wrdTable3.Rows(1).Cells.Merge
wrdTable3.Rows(1).Cells(1).Range.Text = "3. The confirmation at the earliest pl."
wrdTable3.Rows(1).Cells(1).Range.ParagraphFormat.Alignment = wdAlignParagraphJustify
wrdTable3.Rows(1).Cells(1).Range.ParagraphFormat.LineSpacingRule = wdLineSpaceAtLeast
wrdTable3.Rows(1).Cells(1).Range.ParagraphFormat.LineSpacing = 18
With objDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range
.Text = "REQUEST REMINDER"
.ParagraphFormat.Alignment = wdAlignParagraphCenter
.Font.Bold = True
.Font.Name = "Arial"
.Font.Size = 12
.Font.Underline = wdUnderlineSingle
.InsertParagraphAfter
.ParagraphFormat.SpaceAfter = 12 ' twice the font size for 1 "blank line"
End With
End Sub
the above code adds three tables into the word document however, the output document is showing the first two tables as joint. Also the when the table2 is spilling over the next page the output word document has the first table being repeated again on the second page. the first table is also being shown with gridlines despite the gridlines set as false.
In the output first and third table is to be without gridlines. first and second table needs to have space between them. the second table is with gridlines. and the first table is not required to repeat itself
Use the document to insert the paragraph and a section break, and also use the document to reference the range to add the next table
objDoc.Paragraphs.Last.Range.InsertParagraphAfter
objDoc.Paragraphs.Last.Range.InsertBreak Type:=wdSectionBreakContinuous
Dim rng As Range
Set rng = objDoc.Range(objDoc.Paragraphs.Last.Range.Start, objDoc.Paragraphs.Last.Range.End)
Set wrdTable2 = objDoc.Tables.Add(rng, ntotalrecords, ntotalColumns)
Dim intRow As Integer
Dim intCol As Integer

How to set a series names in code generated chart

Good morning.
I created a VB.NET application for Energy Measurement. All is OK, only one thing is a problem. In app, is code to create an excel table and also a chart. Table and chart are generated right, but series names in the chart are with default series names (e.g.: Series1, Series2... etc.). Only the last series has the right name what I set in code (I set all, but they are changed).
My code for the chart is:
Private Sub AddChart(Row As Integer, Columns As Integer)
xlWorkSheet = xlWorkBook.Sheets(2)
xlCharts = xlWorkSheet.ChartObjects
myChart = xlCharts.Add(0, 0, 1000, 500)
EnergyChart = myChart.Chart
xlWorkSheet = xlWorkBook.Sheets(1)
For i As Integer = 1 To Columns - 1
ColValue = ConvertNumberToString(i + 1)
SeriesName(i) = xlWorkSheet.Range(ColValue & "3").Value
chartRange = xlWorkSheet.Range("A4", ColValue & Row - 1)
EnergyChart.SetSourceData(Source:=chartRange)
Series = CType(EnergyChart.SeriesCollection(i), Excel.Series)
Series.Name = SeriesName(i)
Next
With EnergyChart
.HasTitle = True
.ChartTitle.Font.Color = Color.SeaGreen
.ChartTitle.Font.Size = 11
.ChartTitle.Font.Name = "Calibri"
.ChartTitle.Text = ReportFileName
.ChartType = Excel.XlChartType.xlLine
End With
End Sub
Could you please someone tell me why series names are changed to default? Thank you all.
SOLVED:
After code modification it's working right.
Private Sub AddChart(Row As Integer, Columns As Integer)
xlWorkSheet = xlWorkBook.Sheets(2)
xlCharts = xlWorkSheet.ChartObjects
myChart = xlCharts.Add(0, 0, 1000, 500)
EnergyChart = myChart.Chart
xlWorkSheet = xlWorkBook.Sheets(1)
For i As Integer = 1 To Columns - 1
ColValue = ConvertNumberToString(i + 1)
chartRange = xlWorkSheet.Range("A3", ColValue & Row - 1)
EnergyChart.SetSourceData(chartRange)
Series = CType(EnergyChart.SeriesCollection(1), Excel.Series)
Next
With EnergyChart
.HasTitle = True
.ChartTitle.Font.Color = Color.SeaGreen
.ChartTitle.Font.Size = 11
.ChartTitle.Font.Name = "Calibri"
.ChartTitle.Text = ReportFileName
.ChartType = Excel.XlChartType.xlLine
End With
End Sub
Chart OK

Changing datetypes of the datalabels

I have been trying really hard to fix the datatype format of the datalabels. unfortunately, nothing is working out. I want the datalabels to have a fomat of 0.00%. How can I change it?
Here's a sample from the program.
Dim OAPList As Range
Dim SingleCell As Range
Dim Counter As Integer
Set OAPList = Worksheets("Sheet2").Range("E2:E" & lw)
ActiveChart.FullSeriesCollection(1).ChartType = xlColumnClustered
ActiveChart.FullSeriesCollection(1).AxisGroup = 1
ActiveChart.SeriesCollection(1).HasDataLabels = True
Counter = 1
With ActiveChart.SeriesCollection(1)
For Each SingleCell In OAPList
ActiveChart.SeriesCollection(1).Points(Counter).DataLabel.Text = SingleCell.Value
Counter = Counter + 1
Next SingleCell
.DataLabels.ShowValue = True
.DataLabels.NumberFormat = "0%"
'.DataLabels.Position = xlLabelPositionInsideEnd
.DataLabels.Format.AutoShapeType = msoShapeRectangularCallout
.DataLabels.Format.Line.Visible = msoTrue
End With
ActiveChart.SeriesCollection(2).Name = "Estimated Hours"
ActiveChart.FullSeriesCollection(2).ChartType = xlColumnClustered
ActiveChart.FullSeriesCollection(2).AxisGroup = 1
Change following line in For Each Loop:
ActiveChart.FullSeriesCollection(1).Points(Counter).DataLabel.Text = Format(SingleCell.Value, "0%")
Try maybe change this line:
'With ActiveChart.SeriesCollection(1)
With ActiveChart.FullSeriesCollection(1)

Excel - generate multiple series line chart using same column

I have a VBA script that I use to generate multiple line charts in Excel. It used to include 2 series collections per chart (reading from 2 columns) but I since modified it for only one. However now I want it to do 2 series' again but want it to read both collections from the same column. Is this possible?
I've tried modifying the .SeriesCollection(2) to go to the next range further down the column. However this just returns an error 4001.
Sub CreateCharts()
Dim ws As Worksheet
Dim ch As Chart
Dim NumCharts As Integer, ChartName As String, ChartTitle As String, i As Integer
Set ws = Sheets("Charts")
NumCharts = WorksheetFunction.CountA(ws.Rows(2))
For i = 2 To NumCharts Step 1 '1 column of data per chart
ChartName = ws.Cells(2, i) '"chrt" & Range(Col1 & 2)
ChartTitle = ws.Cells(2, i) 'Range(Col1 & 2)
Set ch = Charts.Add
With ch
.ChartType = xlLine
.SetSourceData Source:=ws.Range(ws.Cells(3, i), ws.Cells(20, i)), _
PlotBy:=xlColumns 'range of data for each chart
.SeriesCollection(1).XValues = ws.Range("A3:A20") 'data range of line 1 (test data)
.SeriesCollection(2).XValues = ws.Range("A21:A38") 'data range of line 2 (Rw curve)
.Name = ChartName
.HasTitle = True
.ChartTitle.Characters.text = "#" & ws.Cells(2, i) '& " " & ws.Cells(1, i) 'remove title 'change to "ws.Cells(2, i)" to see titles
.ChartTitle.Left = 600
'HORiZONTAL X AXiS
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.text = "Frequency (Hz)"
.Axes(xlCategory).MajorTickMark = xlNone
.Axes(xlCategory).AxisBetweenCategories = False
.Axes(xlCategory).Border.LineStyle = None
'VERTiCAL Y AXiS
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.text = "Sound Reduction Index (dB)"
.Axes(xlValue).TickLabels.NumberFormat = "0"
.Axes(xlValue).MajorTickMark = xlNone
.Axes(xlValue).HasMajorGridlines = False
.Axes(xlValue).MinimumScale = 10 'minimum value on y
.Axes(xlValue).MaximumScale = 80 'maximum value on y
.Axes(xlValue).Border.LineStyle = None
'LEGEND
.HasLegend = False
'FONT SPECiFiCATiONS
.ChartArea.Format.TextFrame2.TextRange.Font.Size = 14
.ChartArea.Format.TextFrame2.TextRange.Font.Name = "Myriad Pro"
.ChartArea.Border.LineStyle = xlNone
'CHART POSiTiON, SiZE & COLOUR
.PlotArea.Format.Fill.ForeColor.RGB = RGB(242, 242, 242) 'grey background
.PlotArea.Top = 0
.PlotArea.Left = 20
.PlotArea.Height = 440
.PlotArea.Width = 420
'CHART LiNE COLOURS
.SeriesCollection(1).Border.Color = RGB(27, 117, 188) 'first line colour
'.SeriesCollection(2).Border.Color = RGB(0, 0, 0) 'second line colour
'.SeriesCollection(2).LineStyle = xlDashDot
End With
Next i
End Sub
Here is an image example of what I'm wanting to achieve.
Code is slightly modified and tested to work as far my understanding of the objective (to create one 2 series charts per column. 1st series Row 3-20 and 2nd series 21 to 38). Only issue with code was absence of SeriesCollection(2). It is modified to add necessary SeriesCollection and to delete if any automatically added series collection exist.
For i = 2 To NumCharts Step 1 '1 column of data per chart
ChartName = ws.Cells(2, i) '"chrt" & Range(Col1 & 2)
ChartTitle = ws.Cells(2, i) 'Range(Col1 & 2)
Set ch = Charts.Add
'Delete if any automatically added series exist
For x = ch.SeriesCollection.Count To 1 Step -1
ch.SeriesCollection(x).Delete
Next
With ch
.ChartType = xlLine
.SeriesCollection.Add ws.Range(ws.Cells(3, i), ws.Cells(20, i))
.SeriesCollection.Add ws.Range(ws.Cells(21, i), ws.Cells(38, i))
.SeriesCollection(1).XValues = ws.Range(ws.Cells(3, 1), ws.Cells(20, 1))
.SeriesCollection(2).XValues = ws.Range(ws.Cells(21, 1), ws.Cells(38, 1))
.Name = ChartName

Looping through Range1, Range2,...,Range(n) for adding chart data series

I would like to use a single range call within a for loop to add data series to a chart (XY line).
In my example, based on a users input to how many data series they want on a plot (1,2, or 3), ChartData(1), ChartData(2), and ChartData(3) as appropriate that would correspond to SeriesCollection(1), SeriesCollection(2), SeriesCollection(3).
Can't figure out what to use for the ranges.
Dim cb As ComboBox
Dim rge As range
Dim MyChart As Chart
Dim ChartData As range
Dim chartIndex As Integer
Dim ChartName(3) As String
Dim n As Long
Dim i As Long
Dim valid As Boolean: valid = True
m = Application.InputBox("Please enter the number of TML's to graph (1,2, or 3): ", "Select # of TML's", Type:=1)
For i = 1 To m
Set cb = TargetSheet.Shapes("ComboBox" & i).OLEFormat.Object.Object
Set rge = TargetSheet
If IsNumeric(m) And m <= 3 And m > 0 Then _
For a = 1 To m
chartIndex(a) = cb(a).ListIndex
For n = 3 To lastRowTarget2
Select Case chartIndex
Case n - 3
Set ChartData(a) = TargetSheet.range(TargetSheet.Cells(n, 5), TargetSheet.Cells(n, MyRange.Columns.Count - 2))
ChartName = TargetSheet.range("C" & n).Text
UserForm1.TextBox1.Value = TargetSheet.Cells(n, MyRange.Columns.Count).Value
UserForm1.TextBox2.Value = TargetSheet.Cells(n, MyRange.Columns.Count - 1).Value
UserForm1.TextBox3.Value = TargetSheet.Cells(n, 4)
End Select
Next n
Application.ScreenUpdating = False
Set MyChart = TargetSheet.Shapes.AddChart.Chart
With MyChart
.ChartType = xlLineMarkers
.HasTitle = True
.ChartTitle.Text = "Wall Thickness Trend based on Data Points"
.SeriesCollection.NewSeries
.SeriesCollection(a).Name = ChartName
.SeriesCollection(a).Values = ChartData
.SeriesCollection(a).XValues = TargetSheet.range(TargetSheet.Cells(1, 5), TargetSheet.Cells(1, MyRange.Columns.Count))
.SeriesCollection(a).Trendlines.Add Type:=xlLinear
.DisplayBlanksAs = xlInterpolated
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Time (dd-mm-yyyy)"
.Axes(xlValue).MinimumScale = 0
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Measured Wall Thickness (mm)"
.Legend.Delete
.Parent.Height = 350
.Parent.Width = 550
.Parent.Top = 100
.Parent.Left = 100
End With
Dim ser As Series
Set ser = MyChart.SeriesCollection(a)
ser.ErrorBar Direction:=xlY, Include:=xlErrorBarIncludeBoth, Type:=xlErrorBarTypeFixedValue, Amount:=1
Next a

Resources