Putting graph in user named sheet

[LukeMorris]

I want a macro that inserts a graph into a sheet that the user defines the name of.

So far I have this code:

Sub GraphIt()
'
' GraphIt Macro
' Macro recorded 26/01/2006 by Luke Morris
'

'
'Add New Sheet
    Sheets.Add

'Make sure the name is valid
    On Error Resume Next

'Get the new name
     ActiveSheet.Name = InputBox("Name for graph?")

'Keep asking for name if name is invalid
    Do Until Err.Number = 0
        Err.Clear
        ActiveSheet.Name = InputBox("Try Again!" _
          & vbCrLf & "Invalid Name or Name Already Exists" _
          & vbCrLf & "Please name the New Sheet")
    Loop
    On Error GoTo 0

'Remember Sheet
    Dim CurrentSheetName As String
    CurrentSheetName = ActiveSheet.Name

'Make Graph
    Sheets("Log Sheet").Select
    Range("B10:B39,J10:J39").Select
    Range("J10").Activate
    Charts.Add
    ActiveChart.ChartType = xlLine
    ActiveChart.SetSourceData Source:=Sheets("Log Sheet").Range("B10:B39,J10:J39" _
        ), PlotBy:=xlColumns
    ActiveChart.Location Where:=xlLocationAsNewSheet, Name:=("CurrentSheetName")
    With ActiveChart
        .HasTitle = True
        .ChartTitle.Characters.Text = "Cash Flow"
        .Axes(xlCategory, xlPrimary).HasTitle = True
        .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Time"
        .Axes(xlValue, xlPrimary).HasTitle = True
        .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Balance"
    End With
   
    Sheets("Log Sheet").Select
    Range("A1").Activate


End Sub

It works okay, up to the point of the graph being put in and then it makes a sheet called "CurrentSheetName"

Because this line is incorrect I guess:

ActiveChart.Location Where:=xlLocationAsNewSheet, Name:=("CurrentSheetName")

But I'm not sure of the correct code, or whether this is even the right way to go about this.

Can anyone help me with this?

Thanks!

Luke

 

[NdNoviceHlp]

I made some changes for testing, if you change them back this should work for you. Dave

Sub GraphIt()
'
' GraphIt Macro
' Macro recorded 26/01/2006 by Luke Morris
'

'
'Add New Sheet
    Sheets.Add

'Make sure the name is valid
    On Error Resume Next

'Get the new name
     ActiveSheet.Name = InputBox("Name for graph?")

'Keep asking for name if name is invalid
    Do Until Err.Number = 0
        Err.Clear
        ActiveSheet.Name = InputBox("Try Again!" _
          & vbCrLf & "Invalid Name or Name Already Exists" _
          & vbCrLf & "Please name the New Sheet")
    Loop
    On Error GoTo 0

'Remember Sheet
    Dim CurrentSheetName As String
    CurrentSheetName = ActiveSheet.Name

'Make Graph
Set Co = Sheets(CurrentSheetName).ChartObjects.Add(100, 100, 350, 140)

With Co.Chart
.SetSourceData Source:=Sheets("sheet1").Range("A1:A3,B1:B3" _
        ), PlotBy:=xlColumns
.ChartType = xlLine
        .HasTitle = True
        .ChartTitle.Characters.Text = "Cash Flow"
        .Axes(xlCategory, xlPrimary).HasTitle = True
        .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Time"
        .Axes(xlValue, xlPrimary).HasTitle = True
        .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Balance"
    End With
    
    Sheets("Sheet1").Select
    Range("A1").Activate
End Sub

 

[NdNoviceHlp]

After abit more testing I found that my previously posted code didn't work as I had expected. So I learned a few more things that I will share. Firstly, to create a named sheet with a chart object holding a chart series from different sheet (template) data is abit challenging. Also, the series can be made active from either the template sheet or the named sheet (ie. chart updates with data changes). To make more than 1 different charts from a template page, the data has to be either copied to the new page or unlinked from the template data. To maintain the chart and either remove the chart data, or inactivate the data, the data must be unlinked from the chart ("borrowed" Jon's code for this). This code seems kind of useful so I thought I'd post... I also wanted to patch up that previous posting "glitch". Dave

Option Explicit

Sub ChartNamedSheet()
'uses "sheet1" for template chart data
'creates chart object on named sheet
'yvalues = sheet1 A2:etc
'xvalues = sheet1 B2:etc
'adjust code for active(source: sht1 or named sht)/inactive chart
'  (uses Jon Peltier's code to disconnect chart from data)
'adjust code for named sheet to store template data

'Code below for non active chart on named sheet with
'  no data transfer and template data not deleted

Dim CurrentSheetName As String, Lastrow As Integer
Dim X1Value As Range, X2Value As Range, Y1Value As Range
Dim Y2Value As Range, XValue As Range, YValue As Range
Dim Chartrange As Range, Co As ChartObject, Rng As Range

'Jon's vars
Dim nPts As Long, iPts As Long
    Dim xArray As String, yArray As String
    Dim xVals, yVals
    Dim ChtSeries As Series
    Dim iChars As Integer
    Dim sChtName As String
    Dim sSrsName As String
    Dim iPlotOrder As Integer
 
Sheets.Add
'Make sure the name is valid
On Error Resume Next
'Get the new name
     ActiveSheet.Name = InputBox("Name for Chart Tab?")
'Keep asking for name if name is invalid
    Do Until Err.Number = 0
        Err.Clear
        ActiveSheet.Name = InputBox("Try Again!" _
          & vbCrLf & "Invalid Name or Name Already Exists" _
          & vbCrLf & "Please name the New Sheet")
    Loop
    On Error GoTo 0

On Error GoTo ErFix
CurrentSheetName = ActiveSheet.Name
Lastrow = Sheets("sheet1").Cells(Sheets("sheet1") _
.Cells.Rows.Count, "A").End(xlUp).Row()

'force only 1 series
Sheets("Sheet1").Cells(1, "A") = ""
Sheets("Sheet1").Cells(1, "B") = "XValues" 'X series label

'use code below for active data in new sheet and/or
' to delete template data
'Set Rng = Sheets("Sheet1").Range(Sheets("Sheet1").Cells(1, "A"), _
 Sheets("Sheet1").Cells(Lastrow, "B"))

'use code below to copy Yvalues("B) and Xvalues("A) to named sheet
'Rng.Copy Destination:=Sheets(CurrentSheetName).Range("A" & 1)

'make chart(yvalues A2:etc ; xvalues B2:etc) 1st row is labels
'for active chart data on named sheet
'  replace "Sheet1" with CurrentSheetName on code below
Set X1Value = Sheets("Sheet1").Cells(1, "B")
Set X2Value = Sheets("Sheet1").Cells(Lastrow, "B")
Set XValue = Sheets("Sheet1").Range(X1Value, X2Value)
Set Y1Value = Sheets("Sheet1").Cells(2, "A")
Set Y2Value = Sheets("Sheet1").Cells(Lastrow, "A")
Set YValue = Sheets("Sheet1").Range(Y1Value, Y2Value)
Set Chartrange = Sheets("Sheet1").Range(XValue, YValue)

'chart size adjust
Set Co = Sheets(CurrentSheetName).ChartObjects.Add(100, 100, 350, 200)

'format chart adjust
With Co.Chart
        .SetSourceData Source:=Chartrange, PlotBy:=xlColumns
        .ChartType = xlXYScatterSmooth
        .HasTitle = True
        .ChartTitle.Characters.Text = "Cash Flow"
        .Axes(xlCategory, xlPrimary).HasTitle = True
        .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Time"
        .Axes(xlValue, xlPrimary).HasTitle = True
        .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Balance"
End With

'chart location adjust
With Sheets(CurrentSheetName)
    .ChartObjects(1).Top = .Rows(10).Top
    .ChartObjects(1).Left = .Columns("D").Left
End With

'Jon's code to disconnect the data from the chart
' delete this for active data on named sheet or
'  to have active data on all sheets from template
For Each ChtSeries In Co.Chart.SeriesCollection
        nPts = ChtSeries.Points.Count
        xArray = ""
        yArray = ""
        xVals = ChtSeries.XValues
        yVals = ChtSeries.Values
        sSrsName = ChtSeries.Name
        iPlotOrder = ChtSeries.PlotOrder

        For iPts = 1 To nPts
            If IsNumeric(xVals(iPts)) Then
                ''' shorten numbers in X array (remove excess digits)
                iChars = WorksheetFunction.Max _
                    (InStr(CStr(xVals(iPts)), "."), 5)
                xArray = xArray & Left(CStr(xVals(iPts)), iChars) & ","
            Else
                ''' put quotes around string values
                xArray = xArray & """" & xVals(iPts) & ""","
            End If

            ''' shorten numbers in Y array (remove excess digits)
            iChars = WorksheetFunction.Max _
                (InStr(CStr(yVals(iPts)), "."), 5)

           ''' handle missing data - replace blanks and #N/A with #N/A
           If IsEmpty(yVals(iPts)) Or WorksheetFunction.IsNA(yVals(iPts)) Then
               yArray = yArray & "#N/A,"
           Else
               yArray = yArray & Left(CStr(yVals(iPts)), iChars) & ","
           End If

        Next

        ''' remove final comma
        xArray = Left(xArray, Len(xArray) - 1)
        yArray = Left(yArray, Len(yArray) - 1)

        ''' Construct the new series formula
        ChtSeries.Formula = "=SERIES(""" & sSrsName & """,{" & xArray & "},{" _
            & yArray & "}," & CStr(iPlotOrder) & ")"
    Next
'Jon's code ends

'use the line below to delete chart data on named sheet
'Chartrange.Delete
'use line below to delete template data. Nd to set "rng" above!
'Rng.Delete
Sheets("Sheet1").Select
Exit Sub

ErFix:
On Error GoTo 0
MsgBox "You have an error. Try entering some data"
End Sub