Custom date format on chart using VBA

artz

Well-known Member
Joined
Aug 11, 2002
Messages
830
Office Version
  1. 2016
Platform
  1. Windows
Hi,

I've got a macro that creates a panel of small charts. The small charts are nice, however, the date axis causes the chart area to get squished. Currently, the date format is the default that the chart creates, 3/10/2012 is an example.

I am thinking that either just 3/12 or or 3/10/12 would work better. The chart formatting section of the code is:

Code:
With ActiveChart
       .Legend.Delete
       
.Axes(xlCategory).TickLabels.AutoScaleFont = False
With .Axes(xlCategory).TickLabels.Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 8
End With

.Axes(xlValue).TickLabels.AutoScaleFont = False
With .Axes(xlValue).TickLabels.Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 8
End With

.ChartTitle.AutoScaleFont = False
With .ChartTitle.Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 8
End With

With .SeriesCollection(1).Format.Line

.Weight = xlThin
End With

End With

Does anyone know how to add the date format that I desire to my code?

Thanks,

Art
 

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college
Code:
    [color=darkblue]With[/color] ActiveChart
        .Legend.Delete

        .Axes(xlCategory).TickLabels.AutoScaleFont = [color=darkblue]False[/color]
        [COLOR="Red"].Axes(xlCategory).TickLabels.NumberFormat = "m/yy"[/COLOR] [color=green]'e.g. 3/12 or use m/d/yy for 3/30/12[/color]

        [color=darkblue]With[/color] .Axes(xlCategory).TickLabels.Font
            .Name = "Arial"
            .FontStyle = "Regular"
            .Size = 8
        [color=darkblue]End[/color] [color=darkblue]With[/color]

        .Axes(xlValue).TickLabels.AutoScaleFont = [color=darkblue]False[/color]
        [color=darkblue]With[/color] .Axes(xlValue).TickLabels.Font
            .Name = "Arial"
            .FontStyle = "Regular"
            .Size = 8
        [color=darkblue]End[/color] [color=darkblue]With[/color]

        .ChartTitle.AutoScaleFont = [color=darkblue]False[/color]
        [color=darkblue]With[/color] .ChartTitle.Font
            .Name = "Arial"
            .FontStyle = "Bold"
            .Size = 8
        [color=darkblue]End[/color] [color=darkblue]With[/color]

        [color=darkblue]With[/color] .SeriesCollection(1).Format.Line

            .Weight = xlThin
        [color=darkblue]End[/color] [color=darkblue]With[/color]

    [color=darkblue]End[/color] [color=darkblue]With[/color]
 
Upvote 0
Hi Alpha Frog,

Thanks, that did the trick nicely. Could I ask for another mod in the same area of code that I can't figure out? The chart by default comes with markers. I don't want markers.

I recorded a macro and tried to insert it into a section of the code that I posted earlier.:

Code:
Worksheets("Charts").ChartObjects(ChartLoop).Activate

ActiveChart.SeriesCollection(1).Select
    With Selection
   .MarkerStyle = xlNone
    End With

The code compiles and runs but I still get the markers.

Can you think of mod to the code that will prevent markers?

Thanks,

Art
 
Upvote 0
You're welcome.

This loops through each data series on the active chart and turns off the data point markers.

Code:
    [color=darkblue]Dim[/color] srs [color=darkblue]As[/color] Series

    [color=darkblue]With[/color] ActiveChart
    
        [color=darkblue]For[/color] [color=darkblue]Each[/color] srs [color=darkblue]In[/color] .SeriesCollection
            srs.MarkerStyle = xlNone
        [color=darkblue]Next[/color] srs
        
        [color=green]'your other chart formatting code here[/color]
        [color=green]'[/color]
        [color=green]'[/color]
        [color=green]'[/color]
        
    [color=darkblue]End[/color] [color=darkblue]With[/color]
 
Upvote 0
Hi Alpha Frog,

Thanks again for your help and code. I tried what you posted and it compiles and runs, however, the markers are still on the chart. I suspect that another sub in the Modules is deep sixing us.

Keep in mind, I am an admitted hack, having strewn together bits and pieces of code from the Forum, recorded macros, code I've found online, etc.

It's very likely that something in a sub code is undoing your code. If you don't mind, I will post all of the code in both Modules for you to examine.

Considering too, that I want to add a new functional feature and a chart area resizing, it may be good to look at all the code.

With your permission, I'll post the code and describe the new functional feature and what needs to be resized.

Thanks again,

Art
 
Upvote 0
Alpha Frog,

Here's my code in it entirety. If can please take a look. Thanks, Art.

Module1:
Code:
Sub X4()
    Dim lTop As Long, lHeight As Long, lCol As Long, lColumns As Long
    Dim rngXVals As Range, rngYVals As Range
    Dim chtTemp As ChartObject
    Dim sName As String
     
    Call delete_charts
    With Sheets("Data")
        lColumns = .Range("A4").CurrentRegion.Columns.Count
        If lColumns < 2 Then Exit Sub
        lHeight = 150
        Set rngXVals = Range(.Cells(5, 1), .Cells(Rows.Count, 1).End(xlUp))
        
        For lCol = 2 To lColumns
            Set rngYVals = Range(.Cells(5, lCol), _
               .Cells(Rows.Count, lCol).End(xlUp))
            Set chtTemp = Sheets("Charts").ChartObjects.Add(1, _
                lTop, 200, lHeight)
            sName = .Cells(4, lCol)
            
            With chtTemp.Chart.SeriesCollection.NewSeries
                .ChartType = xlLine
                .Name = sName
                .XValues = rngXVals
                .Values = rngYVals
                '.Format.Line.Weight = 1
            End With
            lTop = lTop + lHeight
        Next lCol
    End With
    
    Call ArrangeMyCharts
    Call mov_avg
    Call range_update
End Sub
Sub delete_charts()
Dim wksSheet As Worksheet
Dim objShape As Shape

Set wksSheet = Sheets("Charts")

For Each objShape In wksSheet.Shapes
    objShape.Delete
Next objShape

End Sub

Sub ArrangeMyCharts()
    Dim iChart As Long
    Dim nCharts As Long
    Dim dTop As Double
    Dim dLeft As Double
    Dim dHeight As Double
    Dim dWidth As Double
    Dim nColumns As Long

    dTop = Sheets("Charts").Range("R2")      ' top of first row of charts
    dLeft = Sheets("Charts").Range("S2")    ' left of first column of charts
    dHeight = Sheets("Charts").Range("T2")  ' height of all charts
    dWidth = Sheets("Charts").Range("U2")   ' width of all charts
    nColumns = Sheets("Charts").Range("V2")   ' number of columns of charts
    nCharts = Sheets("Charts").ChartObjects.Count

    For iChart = 1 To nCharts
        With Sheets("Charts").ChartObjects(iChart)
            .Height = dHeight
            .Width = dWidth
            .Top = dTop + Int((iChart - 1) / nColumns) * dHeight
            .Left = dLeft + ((iChart - 1) Mod nColumns) * dWidth
        End With
    Next
    
Sheets("Charts").Select

Call delete_legend
    
End Sub

Sub delete_legend()

Dim NumberOfChartsInActiveSheet As Integer
Dim srs As Series

' Get the number of charts in the active sheet
NumberOfChartsInActiveSheet = ActiveSheet.ChartObjects.Count

For ChartLoop = 1 To NumberOfChartsInActiveSheet
'
' Activate the next chart in the loop
Worksheets("Charts").ChartObjects(ChartLoop).Activate

    With ActiveChart
    
        For Each srs In .SeriesCollection
            srs.MarkerStyle = xlNone
        Next srs
        
        'your other chart formatting code here
        '
        '
        '
        
    End With
' Now do something with the active chart
With ActiveChart
       .Legend.Delete
       
.Axes(xlCategory).TickLabels.AutoScaleFont = False
.Axes(xlCategory).TickLabels.NumberFormat = "m/yy"
.Axes(xlCategory).TickLabels.Orientation = 45
With .Axes(xlCategory).TickLabels.Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 8
End With

.Axes(xlValue).TickLabels.AutoScaleFont = False
With .Axes(xlValue).TickLabels.Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 8
End With

.ChartTitle.AutoScaleFont = False
With .ChartTitle.Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 8
End With

'With .SeriesCollection(1).Format.Line

'.Weight = xlThin
'End With

End With

'move on to next chart in the loop
Next

End Sub

Sub range_update()
'   Credit to Aaron Blood as the originator of this code:
'   http://www.xl-logic.com/pages/charts.html (DynamicChart3.zip)
    Dim oChrt As ChartObject
    Dim szSeries As String
    
    
    On Error GoTo ErrExit
    Application.EnableEvents = False
    
    Set oChrt = Worksheets("Charts").ChartObjects(1)
    
    If Not oChrt Is Nothing Then
    
    For Each oChrt In ChartObjects
    
    
        szSeries = oChrt.Chart.SeriesCollection(1).Formula
        
        szSeries = Left(szSeries, InStrRev(szSeries, ",") - 1)
        
        szSeries = Right(szSeries, (Len(szSeries) - InStrRev(szSeries, ",")))
        
        oChrt.Chart.SetSourceData Source:=Range(szSeries).CurrentRegion
        
        
    Next oChrt
        
    End If
    
    Set oChrt = Nothing
ErrExit:
     Application.EnableEvents = True
End Sub

Module 2:

Code:
Sub mov_avg()
' Procedure to show moving avg for user specified period
' Macro recorded 12/11/2005 by koday
' Cycles through all charts, applies same criteria to each chart
Dim chtobj As ChartObject
Dim Msg As String
Dim n As Integer
n = ActiveSheet.ChartObjects.Count
' User choices:
'   1. Show data series?
'   2. Moving Avg Period? If 0, no moving avg
    per = Range("p2")
'**** Set moving Averages
On Error Resume Next
For Each chtobj In ActiveSheet.ChartObjects
   With chtobj.Chart
   cht_num = chtobj.Index
    ' Remove previous trendlines
    ' Check to see how many trend lines
        n_tr = .SeriesCollection(1).Trendlines.Count
      If n_tr > 0 Then
            For cnt = 1 To n_tr
                 .SeriesCollection(1).Trendlines(cnt).Delete
             Next cnt
       End If
     ' Check to see if period > 0; if yes, add trend line
        If per > 0 Then
        .SeriesCollection(1).Trendlines.Add(Type:=xlMovingAvg, Period:=per _
        , Forward:=0, Backward:=0, DisplayEquation:=False, DisplayRSquared:= _
        False).Select
        With .SeriesCollection(1).Trendlines(1).Border
            .ColorIndex = 3
            '.Weight = xlMedium
            .Weight = xlThin
            '.LineStyle = xlHairline
        End With
        End If
' Check to see if data series to be plotted
         If Range("q2") = "Off" Then
            With .SeriesCollection(1).Border
                .Weight = xlHairline
                .LineStyle = xlNone
            End With
         Else
            With .SeriesCollection(1).Border
                .Weight = xlThin
                .LineStyle = xlAutomatic
            End With
        End If
    'End With
    End With
    Next chtobj
End Sub
 
Upvote 0
Here's a very helpful primer on debugging code.
Debugging VBA

I used Break Points within the code to stop it a various points to see if the code 1.) removed the markers, and 2.) where it added them back on.

It looks like the Sub mov_avg turns back on the markers when you format a data series (With .SeriesCollection(1).Border).

Quick fix: do all the chart formatting after you run Sub mov_avg. At the bottom of X4, change the order you call the other subs so that ArrangeMyCharts is last.

Code:
    Call mov_avg
    Call range_update
    Call ArrangeMyCharts [COLOR="Green"]'Format charts[/COLOR]
 
Upvote 0
Alpha Frog,

Thanks for the info on debugging the code. It's actually fun to step through using F8 and seeing what gets executed while watching the worksheet. :). I am still stumped though- I've stepped through the code a dozen times and can't figure out two things:

1) At what point in the code the titles are being removed; all titles end up as "Chart Title"
2) Why the code in range_update doesn't seem to do anything. On Aaron Blood's original worksheet, the scaling on the chart (x and y) updates as the data changes

I arranged the code to call subs like this:

Code:
Sub X4()
    Dim lTop As Long, lHeight As Long, lCol As Long, lColumns As Long
    Dim rngXVals As Range, rngYVals As Range
    Dim chtTemp As ChartObject
    Dim sName As String
     
    Call delete_charts
    With Sheets("Data")
        lColumns = .Range("A4").CurrentRegion.Columns.Count
        If lColumns < 2 Then Exit Sub
        lHeight = 150
        Set rngXVals = Range(.Cells(5, 1), .Cells(Rows.Count, 1).End(xlUp))
        
        For lCol = 2 To lColumns
            Set rngYVals = Range(.Cells(5, lCol), _
               .Cells(Rows.Count, lCol).End(xlUp))
            Set chtTemp = Sheets("Charts").ChartObjects.Add(1, _
                lTop, 200, lHeight)
            sName = .Cells(4, lCol)
            
            With chtTemp.Chart.SeriesCollection.NewSeries
                .ChartType = xlLine
                .Name = sName
                .XValues = rngXVals
                .Values = rngYVals
                '.Format.Line.Weight = 1
            End With
            lTop = lTop + lHeight
        Next lCol
    End With
    Call mov_avg
    Call range_update
    Call delete_legend
    Call ArrangeMyCharts 'Format charts

End Sub

Do you see what I am missing? Any suggestions?

Thanks,

Art
 
Upvote 0
You're welcome.

1.) The chart titles remain for me.

2.) I don't follow what it's supposed to do? Where does the data change from when you build the charts in X4?
 
Last edited:
Upvote 0
Alpha Frog,

Thanks for staying with me on this. :) As I mentioned in my last post, I get chart titles, but not the values in row 4 of the worksheet, starting at B4. They were there, now I just get the words "Chart Title." I couldn't zero in on the code that was removing the stock symbol title even by single stepping through the code.

The bigger picture is that the data are downloaded via a webquery; i.e., stock market data.

All the stock data share a common date axis starting at A5. Starting at B5, closing prices are downloaded for each corresponding symbol in row 4.

Below is a sample of the worksheet. The download command button doesn't show:

Excel Workbook
ABCDEFGHIJKLMNO
1Start Date:3/12/11************
2End Date:3/11/12***********
3*************
4DateAAAIGAXPBACCATDDDISGEGMHDHONICEJNJ
53/10/201115.836.4844.0271.294.5498.3952.5942.4720.131.4237.0755.79127.5959.61
63/11/201116.0337.3544.2871.644.57100.0252.942.9320.3631.9337.1456.27126.0759.69
73/14/201116.1237.543.9170.744.54102.153.0242.2419.9231.5936.6856.01124.7959.13
83/15/201116.0436.7843.6469.694.44100.7552.441.6219.6132.3536.2955.54123.3358.48
93/16/201115.6635.5942.3667.694.39100.451.5340.618.9531.7835.6854.33123.7757.66
103/17/201116.0135.743.4268.34.45103.1252.3340.7619.2231.4435.7655.21125.3458.13
113/18/201116.1134.9544.1769.14.5105.0652.9941.2319.2531.853655.86124.7758.57
123/21/201116.5537.0344.3271.24.43107.5953.8341.8219.7231.2836.4357.04125.2458.83
133/22/201116.4536.9544.7571.854.42106.7953.6741.4419.4930.7436.2956.54125.7558.79
143/23/201116.9536.5545.0272.724.4106.7653.4642.2419.5331.1636.6257.1127.0358.72
Data


Also, I need each chart to scale properly so that they are visually readable. The sub, range_update was supposed to do that but it doesn't appear to be working.

So, simply, I want to make a panel of charts from the downloaded data for analysis.

Do you have some code suggestions to get me to my endpoint of a panel of charts better or more simply than with my spaghetti code?

Thanks,

Art
 
Upvote 0

Forum statistics

Threads
1,213,494
Messages
6,113,974
Members
448,537
Latest member
Et_Cetera

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top