Offset chart axis tick marks without setting a new minimum value

[MyopicWombat]

Hi,

I'm trying to create a chart that has a long decimal minimum axis value and would like to offset the axis so that only more readable numbers are visible. For example:

change something like this

|----------|----------|----------|
1.23424    2.23424    3.23424    4.23424

to

----|----------|----------|------
    1.5        2.5        3.5

Is there any way to do this?

Thanks

 

[Andrew Poulsom]

Welcome to MrExcel.

To do that you would need to use an XY Scatter chart so that the X axis is a value axis. Then you can adjust the scaling to suit.

 

[MyopicWombat]

Thanks for the response. I am using an XY Scatter plot and I can adjust the minimum, maximum, major and minor units; however I am trying to set the start position of the tick marks without changing the minimum axis value. For example this graph has a different label start point than the axis cross point:

 

[Andrew Poulsom]

Sorry, I don't know how to do that.

 

[MyopicWombat]

Ok, thanks for the reply anyway. I will probably try faking an axis using data labels on a series without the x-axis showing and continue searching for better ideas.

 

[MyopicWombat]

I ended up writing a class to take care of labeling the chart. Here's the code if anyone is interested (probably still rather buggy and not at all optimized/commented):

Module for testing:

Option Explicit

Public newchart As OffsetLabelChart


Sub test()
    Set newchart = New OffsetLabelChart
    'x and y are named ranges
    newchart.Add Sheet1, "=Sheet1!x", "=Sheet1!y", "test", 200, 0, 200, 200, "Chart0"
    newchart.Chart.SetElement msoElementLegendNone
    newchart.Chart.Axes(xlValue).MinimumScale = Sheet1.Range("B2")
    newchart.Chart.Axes(xlValue).MaximumScale = Sheet1.Range("B5")
    newchart.Chart.Axes(xlCategory).MinimumScale = Sheet1.Range("A2")
    newchart.Chart.Axes(xlCategory).MaximumScale = Sheet1.Range("A5")
    newchart.ShowAxes True, True
    
End Sub
Sub xonly()
    newchart.ShowAxes True, False
End Sub
Sub yonly()
    newchart.ShowAxes False, True
End Sub
Sub both()
    newchart.ShowAxes True, True
End Sub
Sub none()
    newchart.ShowAxes False, False
End Sub

OffsetLabelChart Class

Option Explicit


Private WithEvents mChart As Chart
Private mCategoryAxis As olcAxis
Private mValueAxis As olcAxis
Private mValueVisible As Boolean
Private mCategoryVisible As Boolean




Const olcValue = 0
Const olcCategory = 1
Private mPATop As Double, mPALeft As Double, mPAWidth As Double, mPAHeight As Double
Private mPlotAreaSynced As Boolean




Public Function Add(shtAdd As Worksheet, mXRange As String, mYRange As String, seriesName As String, dblLeft As Double, dblTop As Double, dblWidth As Double, dblHeight As Double, strName As String)
    With shtAdd.ChartObjects.Add(Left:=dblLeft, Width:=dblWidth, Top:=dblTop, Height:=dblHeight)
        Set mChart = .Chart
        .Name = strName
        'set chart type etc
    End With
    With mChart
        .ChartType = xlXYScatterSmoothNoMarkers
        With .SeriesCollection.NewSeries
            .Values = mYRange
            .XValues = mXRange
            .Name = seriesName
        End With
        .SetElement (msoElementPrimaryValueGridLinesNone)
        .SetElement (msoElementPrimaryCategoryAxisNone)
        .SetElement (msoElementPrimaryValueAxisNone)


    End With
    Set mValueAxis = New olcAxis
    Set mCategoryAxis = New olcAxis
    
    mCategoryAxis.AxisType = xlCategory
    Set mCategoryAxis.Parent = mChart
    
    mValueAxis.AxisType = xlValue
    Set mValueAxis.Parent = mChart
    
End Function


Property Get Chart() As Chart
    Set Chart = mChart
End Property
Property Get CategoryAxis() As olcAxis
    Set CategoryAxis = mCategoryAxis
End Property
Property Get ValueAxis() As olcAxis
    Set CategoryAxis = mCategoryAxis
End Property


Private Sub mChart_Activate()
    'MsgBox "Active"
End Sub
Public Sub ShowAxes(Category As Boolean, Value As Boolean)
    mValueVisible = Value
    mCategoryVisible = Category
    
    If mChart.SeriesCollection.Count > 0 Then
    
        HandlePlotArea
        mValueAxis.SetAxisState Value
        mCategoryAxis.SetAxisState Category
    
        If Value Then mValueAxis.ShowScale
        If Category Then mCategoryAxis.ShowScale
    End If
    
End Sub
Private Sub HandlePlotArea()
    If mPlotAreaSynced Then
        RecallPlotAreaOriginals
    Else
        SavePlotAreaOriginals
        mPlotAreaSynced = True
    End If
End Sub
Private Sub RecallPlotAreaOriginals()
    mChart.PlotArea.Left = mPALeft * mChart.ChartArea.Width
    mChart.PlotArea.Top = mPATop * mChart.ChartArea.Height
    mChart.PlotArea.Width = mPAWidth * mChart.ChartArea.Width
    mChart.PlotArea.Height = mPAHeight * mChart.ChartArea.Height
End Sub
Private Sub SavePlotAreaOriginals()
    mPALeft = mChart.PlotArea.Left / mChart.ChartArea.Width
    mPATop = mChart.PlotArea.Top / mChart.ChartArea.Height
    mPAWidth = mChart.PlotArea.Width / mChart.ChartArea.Width
    mPAHeight = mChart.PlotArea.Height / mChart.ChartArea.Height
End Sub
Private Sub mChart_Resize()
    'mPlotAreaSynced = False
    ShowAxes mCategoryVisible, mValueVisible
    
End Sub

olcAxis Class

Option Explicit




Private mVisible As Boolean
Private mMinimumScale As Double
Private mMaximumScale As Double
Private mWindow As Double
Private mStartScale As Double
Private mMajorUnit As Double
Private mLabel As String
Private mTicks As Integer
Private mMaxLabelWidth As Double


Private mTickMarks() As Shape
Private mTickLabels() As Shape
Private mAxisLine As Shape
Private mParent As Chart
Private mAxisType As Integer
Private mItemsStored As Integer






Private Function Log10(x)
    Log10 = Log(x) / Log(10#)
End Function
Private Sub RemoveAxis()
    
End Sub
Private Sub Calculate()
    Dim curValue As Double, counter As Integer, ticklabel As Shape, i As Integer, tempString As String
    mMinimumScale = mParent.Axes(mAxisType).MinimumScale
    mMaximumScale = mParent.Axes(mAxisType).MaximumScale
    
    If mAxisType = xlCategory Then mTicks = Int(2 / 150 * mParent.ChartArea.Width + 2) Else mTicks = Int(2 / 150 * mParent.ChartArea.Height + 2)
    
    mWindow = mMaximumScale - mMinimumScale
    mStartScale = Round(mMinimumScale, Int(2 - Log10(mWindow)))
    mMajorUnit = Round(mWindow / mTicks, Int(2 - Log10(mWindow)))
    If mStartScale < mMinimumScale Then mStartScale = mStartScale + mMajorUnit
    For i = mTicks + 3 To UBound(mTickLabels)
        If Not mTickLabels(i) Is Nothing Then
            mTickLabels(i).Delete
            mTickMarks(i).Delete
        End If
        Set mTickLabels(i) = Nothing
        Set mTickMarks(i) = Nothing
    Next i
    ReDim Preserve mTickMarks(1 To mTicks + 2)
    ReDim Preserve mTickLabels(1 To mTicks + 2)
    counter = 1
    curValue = mStartScale
    Do While curValue < mMaximumScale
        If mItemsStored < counter Then
            Set mTickLabels(counter) = mParent.Shapes.AddTextbox(msoTextOrientationHorizontal, counter * 10, counter * 10, 1, 1)
            Set mTickMarks(counter) = mParent.Shapes.AddLine(0, 0, 0, 0)
            mTickMarks(counter).Line.ForeColor.RGB = RGB(134, 134, 134)
            mItemsStored = mItemsStored + 1
        End If
        With mTickLabels(counter).TextFrame2
            .AutoSize = msoAutoSizeShapeToFitText
            .WordWrap = msoFalse
            If InStr(Str(mMajorUnit), ".") Then
                .TextRange.Characters.Text = Format$(curValue, "0." & FillString("0", Int(2 - Log10(mWindow))))
            Else
                .TextRange.Characters.Text = Format$(curValue, "0")
            End If
        End With
        If mMaxLabelWidth < mTickLabels(counter).Width Then mMaxLabelWidth = mTickLabels(counter).Width
        curValue = curValue + mMajorUnit
        counter = counter + 1
    Loop
    mItemsStored = counter - 1
    For i = counter To UBound(mTickLabels)
        If Not mTickLabels(i) Is Nothing Then
            mTickLabels(i).Delete
            mTickMarks(i).Delete
        End If
        Set mTickLabels(i) = Nothing
        Set mTickMarks(i) = Nothing
    Next i
    If mAxisLine Is Nothing Then Set mAxisLine = mParent.Shapes.AddLine(0, 0, 10, 10)
    mAxisLine.Line.ForeColor.RGB = RGB(134, 134, 134)
    mAxisLine.Line.Weight = 1
End Sub


Public Sub SetAxisState(mShow As Boolean)


    If mShow Then
        Calculate
        AdjustPlotArea
    Else
        HideAll
    End If
End Sub
Private Sub HideAll()
    Dim i As Integer
    For i = 1 To UBound(mTickLabels)
        If Not mTickLabels(i) Is Nothing Then
            mTickLabels(i).Visible = False
            mTickMarks(i).Visible = False
        End If
    Next i
    If Not mAxisLine Is Nothing Then mAxisLine.Visible = False
End Sub
Private Sub AdjustCategory()
    If mParent.PlotArea.Left < mTickLabels(1).Width / 2 Then
        mParent.PlotArea.Width = mParent.PlotArea.Width - mTickLabels(1).Width / 2
        mParent.PlotArea.Left = mTickLabels(1).Width
    End If
    If mParent.PlotArea.Height + mParent.PlotArea.Top + mTickLabels(1).Height > mParent.ChartArea.Height Then _
        mParent.PlotArea.Height = mParent.ChartArea.Height - mParent.PlotArea.Top - mTickLabels(1).Height
            
    If mParent.PlotArea.Width + mParent.PlotArea.Left + mTickLabels(mItemsStored).Width / 2 > mParent.ChartArea.Width Then
        mParent.PlotArea.Width = mParent.ChartArea.Width - mParent.PlotArea.Left - mTickLabels(mItemsStored).Width / 2
    End If


End Sub
Private Sub AdjustValue()
    If mParent.PlotArea.Left < mMaxLabelWidth Then
        mParent.PlotArea.Width = mParent.PlotArea.Width - mMaxLabelWidth
        mParent.PlotArea.Left = mMaxLabelWidth
    End If
    If mParent.PlotArea.Height + mParent.PlotArea.Top + mTickLabels(1).Height / 2 > mParent.ChartArea.Height Then _
        mParent.PlotArea.Height = mParent.ChartArea.Height - mParent.PlotArea.Top - mTickLabels(1).Height / 2
    If mParent.PlotArea.Top < mTickLabels(mItemsStored).Height Then
        mParent.PlotArea.Height = mParent.PlotArea.Height - mTickLabels(mItemsStored).Height / 2
        mParent.PlotArea.Top = mParent.PlotArea.Top + mTickLabels(mItemsStored).Height / 2
    End If
End Sub
Private Sub AdjustPlotArea()
   
    If mParent.PlotArea.Width > mParent.ChartArea.Width Then mParent.PlotArea.Width = mParent.ChartArea.Width
    If mParent.PlotArea.Height > mParent.ChartArea.Height Then mParent.PlotArea.Height = mParent.ChartArea.Height
    If mParent.PlotArea.Left < 0 Then mParent.PlotArea.Left = 0
    If mParent.PlotArea.Top < 0 Then mParent.PlotArea.Top = 0
    
    Select Case mAxisType
        Case xlCategory
            AdjustCategory
        Case xlValue
            AdjustValue
    End Select
End Sub
Private Sub ShowCategory()
    Dim i As Integer
    mAxisLine.Left = mParent.PlotArea.Left
    mAxisLine.Width = mParent.PlotArea.Width
    mAxisLine.Top = mParent.PlotArea.Top + mParent.PlotArea.Height
    For i = 1 To mItemsStored
        mTickLabels(i).Left = mParent.PlotArea.Left - mTickLabels(i).Width / 2 + ((Val(mTickLabels(i).TextFrame2.TextRange.Text) - mMinimumScale) / (mWindow)) * mParent.PlotArea.Width
        mTickLabels(i).Top = mParent.PlotArea.Top + mParent.PlotArea.Height
        mTickLabels(i).Visible = True
        mTickMarks(i).Left = mParent.PlotArea.Left + ((Val(mTickLabels(i).TextFrame2.TextRange.Text) - mMinimumScale) / (mWindow)) * mParent.PlotArea.Width
        mTickMarks(i).Top = mParent.PlotArea.Top + mParent.PlotArea.Height
        mTickMarks(i).Width = 0
        mTickMarks(i).Height = 3
        mTickMarks(i).Visible = True
    Next i
End Sub
Private Sub ShowValue()
    Dim i As Integer
    mAxisLine.Left = mParent.PlotArea.Left
    mAxisLine.Top = mParent.PlotArea.Top
    mAxisLine.Height = mParent.PlotArea.Height
    For i = 1 To mItemsStored
        mTickLabels(i).Left = mParent.PlotArea.Left - mTickLabels(i).Width
        mTickLabels(i).Top = mParent.PlotArea.Top + mParent.PlotArea.Height - mTickLabels(i).Height / 2 - ((Val(mTickLabels(i).TextFrame2.TextRange.Text) - mMinimumScale) / (mWindow)) * mParent.PlotArea.Height
        mTickLabels(i).Visible = True
        mTickMarks(i).Height = 0
        mTickMarks(i).Width = 3
        mTickMarks(i).Left = mParent.PlotArea.Left - mTickMarks(i).Width
        mTickMarks(i).Top = mParent.PlotArea.Top + mParent.PlotArea.Height - ((Val(mTickLabels(i).TextFrame2.TextRange.Text) - mMinimumScale) / (mWindow)) * mParent.PlotArea.Height
        mTickMarks(i).Visible = True
    Next i
End Sub
Public Sub ShowScale()
    Dim i As Integer
    mAxisLine.Height = 0
    mAxisLine.Width = 0
    Select Case mAxisType
        Case xlCategory
            ShowCategory
        Case xlValue
            ShowValue
    End Select
    mAxisLine.Visible = True
End Sub
Private Function FillString(chrChar As String, intLength As Integer) As String
    Dim i As Integer
    For i = 1 To intLength
        FillString = FillString & chrChar
    Next i
End Function
Property Set Parent(chtParent As Chart)
    Set mParent = chtParent
End Property
Property Let AxisType(intAxisType As Integer)
    mAxisType = intAxisType
End Property
Property Let PlotAreaSizeMatched(blnMatched As Boolean)
    mPlotAreaSizeMatched = blnMatched
End Property
Property Get PlotAreaSizeMatched() As Boolean
    PlotAreaSizeMatched = mPlotAreaSizeMatched
End Property


Private Sub Class_Initialize()
    ReDim mTickMarks(1 To 1)
    ReDim mTickLabels(1 To 1)
End Sub

 

[Golding]

I recently had to do something similar, but I wasn't willing to create my entire chart in VBA. I found a pretty decent hack to do it in excel though. You can do this by creating a dummy series that is essentially a straight vertical line on your axis. So make all the X values of your series equal to zero and then make the Y values equal to the tickmarks you want show. Then just format it to look like tickmarks. I got this idea from Arbitrary Axis Scale. Also here is a similar question and answer that I wrote: microsoft excel - Offset the tickmarks of a secondary axis - Super User

 

[MyopicWombat]

Thanks for the links! I went the VBA route because I was already dealing with creating the charts via VBA in the first place, but this looks much easier.