INTELLIGENT WORK FORUMS FOR ENGINEERING PROFESSIONALS
Log In
Come Join Us!
Are you an Engineering professional? Join EngTips Forums!
 Talk With Other Members
 Be Notified Of Responses
To Your Posts
 Keyword Search
 OneClick Access To Your
Favorite Forums
 Automated Signatures
On Your Posts
 Best Of All, It's Free!
*EngTips's functionality depends on members receiving email. By joining you are opting in to receive email.
Posting Guidelines
Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Engineering spreadsheets FAQ
Engineering spreadsheets
Can you force an Excel XYChart to have equal scales? by Denial
Posted: 24 Sep 15 (Edited 5 Oct 15)

The attached VBA subroutine will force an Excel XYchart to have equal scaling on its X ("Category") and Y ("Value") axes. It has evolved over many years, with major contributions from multiple people on this web site and elsewhere.
Why might you want to achieve equal scaling on the two axes? In my case it was mainly for creating datadriven diagrams. Other people have found other uses for it.
CODESub GiveActivePlotEqualScales()
'
' PURPOSE
'
' Changes the X and Y scales of an Excel XYScatter chart by
' exactly the right amount to result in the two scales being equal.
'
' The chart, which can be embedded in a worksheet or can be on its
' own ChartSheet, has to be "active" when this subroutine runs.
'
' The subroutine will not run on a protected worksheet unless the
' protection allows the user to "edit objects". However a user who
' can "edit objects" can also mess up the plot in various ways, so
' the protection would seem to be somewhat pointless.
'
' HISTORY
'
' The original subroutine was developed by Jon Peltier, and placed
' on his PeltierTech website at URL
' www.peltiertech.com/Excel/Charts/SquareGrid.html
' where it was still accessible in September 2015.
' A modified version of the routine was placed on the "Engineering
' spreadsheets" forum of the EngTips web site (www.EngTips.com)
' by contributor Panars in December 2005, in thread 770141275.
' Two other EngTipers, Electricpete and Denial then made some
' further modifications to it as the thread developed.
'
' In 2010 Denial posted an improved version on EngTips. See
' thread 770274998. The main problem fixed was that for
' charts with at least one axis displayed there were still some,
' seemingly random, circumstances under which the resulting scales
' would not be adequately equal.
'
' MODIFICATIONS SINCE MID 2015
'
' Sep 2015. Correction for where a worksheet has more than one embedded
' chart object. (Previously chart object 1's series were used to
' calculate the scaling factors for all the chart objects.)
' Sep 2015. In charts where only one axis is utilised we now set that
' axis's MajorUnitsIsAuto parameter to True. This avoids some grossly
' inappropriate label spacings under some circumstances.
' 24Sep15. This updated version was posted on EngTips
' as thread 770395377 and as FAQ 7701901.
' 27Sep15. Added check for whether a chart is actually "active".
'
Dim s As Series, PointsList As Variant, PointCount As Long
Dim PlotInHt As Double, PlotInWd As Double
Dim HaveXaxis As Boolean, HaveYaxis As Boolean
Dim PlotName As String, PlotNumb As Long
Dim TypeOfPlot As Long, SubtypeOfPlot As Long
Dim IsEmbedded As Boolean
Dim Xmax As Double, Xmin As Double, Xdel As Double
Dim Ymax As Double, Ymin As Double, Ydel As Double
Dim XmaxData As Double, XminData As Double
Dim YmaxData As Double, YminData As Double
Dim Xpix As Double, Ypix As Double
Dim Distort As Double, Distort_pc As Double
Dim CycleCount As Long, MaxCycles As Long
Dim AxisControlling As String
Dim MoveDist As Double, Shift As Long
Dim Margin As Double, Temp As Double
'
Const SubName As String = "GiveActivePlotEqualScales"
'
' Check whether there is in fact an active chart.
'
If ActiveChart Is Nothing Then
MsgBox "There is no active chart.", , "Subroutine " & SubName
Exit Sub
End If
'
' Determine whether the active chart is embedded in a worksheet or
' is a sheet in its own right. (If the activesheet's type is not
' a worksheet, assume that it is a chart.)
'
IsEmbedded = (ActiveSheet.Type = xlWorksheet)
'
With ActiveChart 'The "End With" for this is at the very end of the subroutine.
'
' Get various properties of the chart. Check chart type.
'
If IsEmbedded Then
PlotName = .Parent.Name
Else
PlotName = .Name
End If
TypeOfPlot = .Type
SubtypeOfPlot = .ChartType
If TypeOfPlot <> xlXYScatter Then
MsgBox "Scaleequalising macro is intended only for an XY Scatter chart.", , _
PlotName & " / " & SubName
Exit Sub
End If
'
' Get presence/absence for each axis.
'
HaveXaxis = .HasAxis(xlCategory)
HaveYaxis = .HasAxis(xlValue)
'
' Determine the extreme X and Y values of all the data points,
' looping through all the data series on the chart.
'
' Note that VBA generates an error if we try to do anything with
' an empty series: hence the need for the "on error" statements.
'
Xmin = 9.999999E+100: Ymin = Xmin: Xmax = Xmin: Ymax = Xmax
PointCount = 0
If IsEmbedded Then
PlotNumb = ActiveChart.Parent.Index
For Each s In ActiveSheet.ChartObjects(PlotNumb).Chart.SeriesCollection
On Error Resume Next
PointCount = PointCount + s.Points.Count
PointsList = s.XValues
Xmax = Application.Max(Xmax, PointsList)
Xmin = Application.Min(Xmin, PointsList)
PointsList = s.Values
Ymax = Application.Max(Ymax, PointsList)
Ymin = Application.Min(Ymin, PointsList)
On Error GoTo 0
Next s
Else
For Each s In .SeriesCollection
On Error Resume Next
PointCount = PointCount + s.Points.Count
PointsList = s.XValues
Xmax = Application.Max(Xmax, PointsList)
Xmin = Application.Min(Xmin, PointsList)
PointsList = s.Values
Ymax = Application.Max(Ymax, PointsList)
Ymin = Application.Min(Ymin, PointsList)
On Error GoTo 0
Next s
End If
'
' Suppress the following two error messages, because in the present
' context the subroutine is being initiated automatically. (And
' we don't want to alarm the user, do we?)
'
If PointCount <= 0 Then
' MsgBox "Chart contains no points.", , PlotName & " / " & SubName
Exit Sub
End If
If Xmax  Xmin + Ymax  Ymin <= 1E20 Then
' MsgBox "Chart is of zero size.", , PlotName & " / " & SubName
Exit Sub
End If
'
' Expand these maximum and minimum values very slightly, so that
' line segments running along the very edge of the graph area
' do not get missed. If the chart subtype is "smoothed"
' use a bit more expansion, to allow for the smoothed edges to
' extend beyond the actual data points.
'
' The sizes used for these "margins" are no better than guesses.
'
Margin = 0.005
If SubtypeOfPlot = xlXYScatterSmooth Or _
SubtypeOfPlot = xlXYScatterSmoothNoMarkers Then Margin = 0.04
Temp = Margin * (Xmax  Xmin)
Xmax = Xmax + Temp
Xmin = Xmin  Temp
Temp = Margin * (Ymax  Ymin)
Ymax = Ymax + Temp
Ymin = Ymin  Temp
'
' Record these max & min values for later use.
'
XminData = Xmin: XmaxData = Xmax: YminData = Ymin: YmaxData = Ymax
'
' If we have an X axis, find out what MajorUnit would autoapply.
'
If HaveXaxis Then
With .Axes(xlCategory)
.MaximumScaleIsAuto = True
.MinimumScaleIsAuto = True
.MajorUnitIsAuto = True
Xdel = .MajorUnit
.MaximumScaleIsAuto = False
.MinimumScaleIsAuto = False
.MajorUnitIsAuto = False
End With
If Xmax = Xmin Then Xdel = 0
End If
'
' If we have a Y axis, find out what MajorUnit would autoapply.
'
If HaveYaxis Then
With .Axes(xlValue)
.MaximumScaleIsAuto = True
.MinimumScaleIsAuto = True
.MajorUnitIsAuto = True
Ydel = .MajorUnit
.MaximumScaleIsAuto = False
.MinimumScaleIsAuto = False
.MajorUnitIsAuto = False
End With
If Ymax = Ymin Then Ydel = 0
End If
'
' If have both X and Y axes, use the larger MajorUnit for both.
'
If HaveXaxis And HaveYaxis Then
If Ydel >= Xdel Then
Xdel = Ydel
Else
Ydel = Xdel
End If
End If
'
' For directions with axes, round the minimum values down to be
' multiples of the axis's MajorUnit. Round only the "minimum"
' values, since these are the ones that serve as the base for the
' markings along the axes. (And if we do it for the maximum
' as well we risk overconstraining our problem.)
'
' At the same time, set the MajorUnit.
' Note that the calculation for the MajorUnit needs to be
' set to "Auto" if the axis concerned is the only axis in use,
' or the unit spacing can be badly wrong. (MajorAxisIsAuto was
' set to False near the start of the subroutine.)
'
If HaveXaxis And Xdel <> 0 Then
Xmin = Xdel * Round((Xmin  0.5 * Xdel) / Xdel)
If HaveYaxis Then
.Axes(xlCategory).MajorUnit = Xdel
Else
.Axes(xlCategory).MajorUnitIsAuto = True
End If
End If
If HaveYaxis And Ydel <> 0 Then
Ymin = Ydel * Round((Ymin  0.5 * Ydel) / Ydel)
If HaveXaxis Then
.Axes(xlValue).MajorUnit = Ydel
Else
.Axes(xlValue).MajorUnitIsAuto = True
End If
End If
'
' Get the dimensions of the part of the chart used for the actual
' graphing, then use these to calculate the present values of the
' relative scaling factors in the X & Y directions.
'
PlotInWd = .PlotArea.InsideWidth
PlotInHt = .PlotArea.InsideHeight
Xpix = (Xmax  Xmin) / PlotInWd
Ypix = (Ymax  Ymin) / PlotInHt
'
' We can now set about equalising the scales. In an ideal world
' this would be a simple, single pass, exercise. But it turns
' out that, for a chart that has any axes displayed, a change to
' the defined extents of a displayed axis will sometimes change
' the chart's InsideWidth or InsideHeight properties. I cannot
' find a way to predict when this will or will not happen.
'
' This behaviour is a major PItA. It requires us to adopt an
' iterative approach. Implement the iterations with a Forâ€”Next
' loop, and set a fairly low limit on the maximum number of
' iterations allowed. (But not too low: I had one chart which
' required 9 iterations to achieve adequately equal scales.)
'
MaxCycles = 15
For CycleCount = 1 To MaxCycles
'
' Adjust one of the scales in an attempt to achieve equality.
'
If Ypix < Xpix Then
'
' X DIRECTION CONTROLS THE SIZE OF THE CHART.
'
AxisControlling = "X"
'
'Set the Xaxis extents to the data's extents.
'
.HasAxis(xlCategory) = True
.Axes(xlCategory).MinimumScale = Xmin
.Axes(xlCategory).MaximumScale = Xmax
If Not HaveXaxis Then .HasAxis(xlCategory) = False
'
' Recalculate the scaling factors, which might have changed.
'
PlotInWd = .PlotArea.InsideWidth
PlotInHt = .PlotArea.InsideHeight
Xpix = (Xmax  Xmin) / PlotInWd
Ypix = (Ymax  Ymin) / PlotInHt
'
' Calculate the value of Ymax that will result in
' the same value for the scale of the Yaxis as we
' have just defined for the scale of the Xaxis.
'
Ymax = Ymin + Xpix * PlotInHt
'
' The available space in the Ydirection will be greater
' than what is needed by the actual graphing. Attempt
' to position the graphing centrally in this space. If
' the chart has its Yaxis displayed, then any shift
' must be a multiple of the MajorUnit.
'
MoveDist = 0.5 * (Ymax + Ymin  YmaxData  YminData)
If HaveYaxis Then
Shift = Round(MoveDist / Ydel, 0)
Ymin = Ymin  Shift * Ydel
Ymax = Ymax  Shift * Ydel
Else
Ymin = Ymin  MoveDist
Ymax = Ymax  MoveDist
End If
'
' Set the Yaxis extents to these calculated values.
'
.HasAxis(xlValue) = True
.Axes(xlValue).MinimumScale = Ymin
.Axes(xlValue).MaximumScale = Ymax
If Not HaveYaxis Then .HasAxis(xlValue) = False
Else
'
' Y DIRECTION CONTROLS THE SIZE OF THE CHART.
'
AxisControlling = "Y"
'
' Set the Yaxis extents to the data's extents.
'
.HasAxis(xlValue) = True
.Axes(xlValue).MinimumScale = Ymin
.Axes(xlValue).MaximumScale = Ymax
If Not HaveYaxis Then .HasAxis(xlValue) = False
'
' Recalculate the scaling factors, which might have changed.
'
PlotInWd = .PlotArea.InsideWidth
PlotInHt = .PlotArea.InsideHeight
Xpix = (Xmax  Xmin) / PlotInWd
Ypix = (Ymax  Ymin) / PlotInHt
'
' Calculate the value of Xmax that will result in
' the same value for the scale of the Xaxis as we
' have just defined for the scale of the Yaxis.
'
Xmax = Xmin + Ypix * PlotInWd
'
' The available space in the Xdirection will be greater
' than what is needed by the actual graphing. Attempt
' to position the graphing centrally in this space. If
' the chart has its Xaxis displayed, then any shift
' must be a multiple of the MajorUnit.
'
MoveDist = 0.5 * (Xmax + Xmin  XmaxData  XminData)
If HaveXaxis Then
Shift = Round(MoveDist / Xdel, 0)
Xmin = Xmin  Shift * Xdel
Xmax = Xmax  Shift * Xdel
Else
Xmin = Xmin  MoveDist
Xmax = Xmax  MoveDist
End If
'
' Set the Xaxis extents to these calculated values.
'
.HasAxis(xlCategory) = True
.Axes(xlCategory).MinimumScale = Xmin
.Axes(xlCategory).MaximumScale = Xmax
If Not HaveXaxis Then .HasAxis(xlCategory) = False
End If
'
' Recalculate the scaling factors, which might have changed yet again.
'
PlotInWd = .PlotArea.InsideWidth
PlotInHt = .PlotArea.InsideHeight
Xpix = (Xmax  Xmin) / PlotInWd
Ypix = (Ymax  Ymin) / PlotInHt
'
' If the discrepancy between the scaling factors is less than
' say 0.5%, then we can apply the Bobby McFerrin / Meher Baba
' algorithm ("Don't worry, be happy").
'
' Otherwise, sigh deeply and begin another iteration.
'
Distort = Abs((Xpix  Ypix) / (Xpix + Ypix))
If Distort < 0.0025 Then GoTo Finish_Off
Next CycleCount
'
' Tell the longsuffering user that adequate convergence
' has not been achieved. Then carry on regardless.
'
Distort_pc = Round(100 * Distort, 1)
MsgBox "Discrepancy between scales is " & Distort_pc & "%" & Chr(13) & _
"after " & MaxCycles & " iterations.", , _
PlotName & " / " & SubName
'
Finish_Off:
'
End With 'Terminates the "With ActiveChart" near the top of the subroutine.
'
End Sub

Back to Engineering spreadsheets FAQ Index
Back to Engineering spreadsheets Forum 

Resources
3D printing offers a great deal of powerful potential, not just in shaping the way businesses operate but in actually making the world a better place. Download Now
Media stories tend to emphasize the most futuristic and dramatic aspects of 3D printing, but additive manufacturing (AM) is already serving much more practical purposes. Download Now
Engineers need tools that enable them to manage rising product complexities, adapt to changing customer expectations and support new technologies. Download Now
Eightynine percent of companies that have adopted modelbased definition (MBD) are either satisfied or extremely satisfied by the results. Download Now

