• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 814
  • Last Modified:

need macro to create an x-y graph for worksheet

Hi,

I have attached my excel spreadsheet.   I need to add a function to my existing macro.  Upon pressing a button on the "compare plans" worksheet, the current macro creates a new worksheet, populates it by copying the contents (as values, not formula) of "compare plans", and titles it according to the contents of cell F14.   The new functionality that I need is as follows:  the macro needs to create an x-y line chart that graphs the date (x axis) and 'running balance' (column F), and places the chart in that newly created worksheet (see the current macro).  In other words, when I press the button in "compare charts" worksheet, the contents of "compare charts" are copied to a new worksheet (my existing macro already does this), the new worksheet is titled according to the contents of cell F14 (my existing macro already does this), and a chart showing "running balance" vs time is also displayed in the new worksheet (need added functionality added to my macro).   Note that the active cursor should end up in the original "compare plans" worksheet, rather than change over to the new worksheet.)  The chart title should be obtained from cell F14.  The y axis should be labeled "$" and show values rounded to the nearest $1000, and the x-axis should show the month and year in mm-yy format.

Thanks in advance!
CopySheetToRecord.xlsm
0
Cam Raben
Asked:
Cam Raben
  • 8
  • 3
2 Solutions
 
Cam RabenAuthor Commented:
Just to clarify, I already have a macro (see attached spreadsheet) that does everything except create the x-y line chart.  This question is to add functionality to my macro that will do that.  Thanks.
0
 
FamousMortimerCommented:
Hi,

How is this?  You can adjust the SizeChart function if necessary to change the size and position.

Option Explicit

Sub CopySheetToRecord()
    Dim ws As Worksheet, shName As String, i As Integer
    
    shName = WorksheetFunction.Text(Sheets("COMPARE PLANS").Range("F14"), "#,###")
    i = 0
    For Each ws In Worksheets
        If ws.Name = shName Then
            i = 1
        End If
    Next ws
    If i = 1 Then
        MsgBox "Sheet " + shName + " exists, copy not performed, program stop", vbCritical
        End
    Else
        Sheets("COMPARE PLANS").Copy After:=Sheets(Worksheets.Count)
        Cells.Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Application.CutCopyMode = False
        Range("A1").Select
        ActiveSheet.Name = shName
        MakeChart (shName)
    End If
End Sub

Sub MakeChart(ByVal shName As String)
    With Sheets(shName)
        .Shapes.AddChart2(227, xlLine).Select
        ActiveChart.SetSourceData Source:=.Range("D22:H" & .Range("E1048576").End(xlUp).Row)
        SizeChart (.Shapes("Chart 1"))
    End With
End Sub

Sub SizeChart(ByVal chart As Shape)
    With chart
        .Top = 82
        .Left = 612
        .Height = 210
        .Width = 520
    End With
End Sub

Open in new window

CopySheetToRecord.xlsm
0
 
Cam RabenAuthor Commented:
A couple of points.  

1.  I got an error when I tried to use the macro.  Run time error 438:  object doesn't support this property or method.
Error occured in the shapes.addchart2 line below.

Sub MakeChart(ByVal shName As String)
    With Sheets(shName)
        .Shapes.AddChart2(227, xlLine).Select
        ActiveChart.SetSourceData Source:=.Range("D22:H" & .Range("E1048576").End(xlUp).Row)
        SizeChart (.Shapes("Chart 1"))
    End With
End Sub

2.  The chart that you were able to create and place on the 85,500 tab has some numbers on the x axis that are unknown to me.  Can those be removed?  Also Can we show two x-axis labels per year (Jan 1 and June 1, for each year)?  Or will that be two crowded?

3.  Can we put the cursor focus back on the original tab ("compare plans") rather than leave it on the most recently created worksheet?

Thanks in advance!
0
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 
Cam RabenAuthor Commented:
I will be back in the office on Tuesday - thanks.
0
 
Robberbaron (robr)Commented:
just change the AddChart2 to AddChart.

but i also added bits to format the axes and corrected the data range.
Sub CopySheetToRecord()
    Dim ws As Worksheet, shName As String, i As Integer
    
    Dim wsStart As Worksheet
    Set wsStart = ActiveSheet
    
    shName = WorksheetFunction.Text(Sheets("COMPARE PLANS").Range("F14"), "#,###")
    i = 0
    For Each ws In Worksheets
        If ws.Name = shName Then
            i = 1
        End If
    Next ws
    If i = 1 Then
        MsgBox "Sheet " + shName + " exists, copy not performed, program stop", vbCritical
        End
    Else
        Sheets("COMPARE PLANS").Copy After:=Sheets(Worksheets.Count)
        Cells.Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Application.CutCopyMode = False
        Range("A1").Select
        ActiveSheet.Name = shName
        MakeChart ActiveSheet.Name
    End If
    
    wsStart.Activate   '<<< reset to start
End Sub

Sub MakeChart(ByVal shName As String)
    Dim c1 As chart
    
    With Sheets(shName)
        .Shapes.AddChart(227, xlLine).Select
        Set c1 = ActiveChart
        
        '<<< desired data range is only columns E & F ??
        c1.SetSourceData Source:=.Range("E22:F" & .Range("E1048576").End(xlUp).Row)
        c1.ChartTitle.Text = .Range("F14").Value
        'c1.Name = .Range("F14").Value
        c1.Axes(xlValue).TickLabels.NumberFormat = "$#,##0"
        c1.Axes(xlValue).DisplayUnit = xlThousands
        c1.Axes(xlCategory).TickLabels.NumberFormat = "mm-yy"  '<<<  mmm-yy may be better
        c1.Legend.Left = 220
        c1.Legend.Top = 21
        c1.PlotArea.Width = 280
        SizeChart .Shapes("Chart 1")

    End With
End Sub

Open in new window

0
 
Cam RabenAuthor Commented:
@Robr - Thanks for post.  I tried to run this to no avail.   Could you enable your macro in a working spreadsheet and upload it intact?   Thanks in advance!
0
 
Cam RabenAuthor Commented:
The macro did not work Robr.   I am uploading the spreadsheet again, hoping that you can embed your working version of the macro into it and save it and send it back.  Thanks.
CopySheetToRecord.xlsm
0
 
Cam RabenAuthor Commented:
By the way, the run-time error 438 states "Object doesn't support this property or method."

And when I debug it, I get an error on the .shapes.addchart2 line below.

Sub MakeChart(ByVal shName As String)
    With Sheets(shName)
        Shapes.AddChart2(227, xlLine).Select
        ActiveChart.SetSourceData Source:=.Range("D22:H" & .Range("E1048576").End(xlUp).Row)
        SizeChart (.Shapes("Chart 1"))
    End With
End Sub
0
 
Cam RabenAuthor Commented:
Thanks to you both.  I got it to work, except for Robr's code with his improvements.  I still gave it an A because it's a huge improvement over what I started with - I now have a chart in my spreadsheet.  I appreciate the assistance.
0
 
Robberbaron (robr)Commented:
you have an extra 2 in code, a carry over from Mortimer...

    With Sheets(shName)
        .Shapes.AddChart(227, xlLine).Select

Open in new window



NOT           .Shapes.AddChart2(227, xlLine).Select
0
 
Cam RabenAuthor Commented:
Thanks Robr.  That works!  Is there an easy way to also graph the IRA value on the same chart?  (column H of 'compare plans' tab?)    Also, if I want to set my cursor back into the 'compare plans' tab, do i have to write a new subroutine or is there a line of VBA code that I could put at the end of my routine that would do this?
0
 
Robberbaron (robr)Commented:
my code version of CopySheetToRecord also had this...

   
    Dim wsStart As Worksheet
    Set wsStart = ActiveSheet  '<<<< save current sheet
....
.....

wsStart.Activate   '<<< reset to start    

have added the modified workbook as requested
0

Featured Post

Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

  • 8
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now