CODEWITHSUNDEEP
excelloopsfigurevba
Jordan Poitras
Jordan Poitras

Reputation: 11

Create unique chart for each sheet with VBA

I am attempting to create a chart in each sheet of my workbook using VBA. I have used code gleaned from the net. The closest I came to success was ending up with 28 of the same chart on the first sheet.

Here is that code where each sheet has the data in the specified location

Sub WorksheetLoop()
  Dim WS_Count As Integer
  Dim I As Integer

  ' Set WS_Count equal to the number of worksheets in the active
  ' workbook.
  WS_Count = ActiveWorkbook.Worksheets.Count

  ' Begin the loop.
  For I = 1 To WS_Count
    ActiveSheet.Range("P2:AB2153").Select
    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.ChartType = xlXYScatterLines
    ActiveChart.SetSourceData Source:=Range("$P$2:$AB$2153")
    ActiveChart.Axes(xlValue).MinimumScale = 0.5
    ActiveChart.ChartArea.Select
    ActiveSheet.Shapes("Chart 1").IncrementLeft 393.75
    ActiveSheet.Shapes("Chart 1").IncrementTop -31243.1249606299

    MsgBox ActiveWorkbook.Worksheets(I).Name
  Next I
End Sub

You'll notice that I moved the shape after it is created. This was because the very first time they were all located at the bottom of a very long sheet

I then tried adding 

Dim thisSheet As Worksheet

For Each sheet In Sheets

and changing ActiveSheet to thisSheet

No success.

I have over 100 sheets in many workbooks Any help would be appreciated

Upvotes: 0

Views: 1391

Answers (2)

Jordan Poitras
Jordan Poitras

Reputation: 11

I came up with my own answer and added some other other stuff

:

Sub WorksheetLoopchart()

     Dim WS_Count As Integer
     Dim I As Integer

     ' Set WS_Count equal to the number of worksheets in the active
     ' workbook.
     WS_Count = ActiveWorkbook.Worksheets.Count

     ' Begin the loop.
     For I = 1 To WS_Count

    Worksheets(ActiveSheet.Index + 1).Select
    ActiveSheet.Range("P2:AB2153").Select
    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.ChartType = xlXYScatterLines
    ActiveChart.SetSourceData Source:=Range("$P$2:$AB$2153")
    ActiveChart.Axes(xlValue).MinimumScale = 0.1
    ActiveChart.Axes(xlCategory, xlPrimary).HasTitle = True
    ActiveChart.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Wavelength (nm)"
    ActiveChart.Axes(xlValue, xlPrimary).HasTitle = True
    ActiveChart.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Absolute Reflectance"
    ActiveChart.SetElement (msoElementLegendRight)

        ' Insert your code here.
        ' The following line shows how to reference a sheet within
        ' the loop by displaying the worksheet name in a dialog box.
        MsgBox ActiveWorkbook.Worksheets(I).Name

     Next I

  End Sub

The index + 1 did the trick

Upvotes: 0

Tim Williams
Tim Williams

Reputation: 166126

Compiled but not tested:

Sub WorksheetLoop()

    Dim WS As Worksheet, co As Object

    For Each WS In ActiveWorkbook.Worksheets

        Set co = WS.Shapes.AddChart()

        ActiveSheet.Range("P2:AB2153").Select

        'adjust to suit...
        co.Top = 100
        co.Left = 100
        co.Width = 300
        co.Height = 250

        With co.Chart
            .ChartType = xlXYScatterLines
            .SetSourceData Source:=WS.Range("$P$2:$AB$2153")
            .Axes(xlValue).MinimumScale = 0.5
        End With

        Debug.Print "Processed: " & WS.Name

    Next WS
End Sub

Upvotes: 2

Related Questions