Scatter plot based on selection

[carter963]

I wanted to automate making a scatter plot based on a selection. I snagged some code from here and tried to modify it to work with my data. I though I understood the code, but it's giving me a lot of trouble mostly around how each series is added. I finally got it to select based on rows, but it's adding too many series for each sample. The original code had everything in columns, but typically we get the data from vendors in the format in the table below. It would be more difficult to get people to change how they arrange the data than just changing the code. I also want to understand what's going on with the code... any recommendations on resources for this topic would be helpful.

Time	5	10	15	20	30	45	60	75
Sample1	94.8	106.5	106.3	105.7	106.3	105.8	105.8	105.8
Sample2	93.3	101.2	101.4	101.2	101.9	101.7	102.7	102.4
Sample3	100.0	100.8	100.6	100.4	100.1	100.5	100.2	100.8
Sample4	96.7	101.7	102.1	102.2	102.3	102.3	102.4	102.1
Sample5	9.9	24.1	37.5	48.1	65.1	82.8	93.5	101.0
Sample6	47.7	97.2	104.5	104.7	104.7	104.2	104.8	104.8

Option Explicit

Sub MultiY_OneX_Chart()

    Dim rngDataSource As Range
    Dim iDataRowsCt As Long
    Dim iDataColsCt As Integer
    Dim iSrsIx As Integer
    Dim iSrsIy As Integer
    Dim chtChart As Chart
    Dim srsNew As Series

    If Not TypeName(Selection) = "Range" Then
        '' Doesn't work if no range is selected
        MsgBox "Please select a data range and try again.", _
            vbExclamation, "No Range Selected"
    Else
        Set rngDataSource = Selection
        With rngDataSource
            iDataRowsCt = .Rows.Count
            iDataColsCt = .Columns.Count
        End With

        '' Create the chart
        Set chtChart = ActiveSheet.ChartObjects.Add( _
            Left:=ActiveSheet.Columns(ActiveWindow.ScrollColumn).Left + _
                ActiveWindow.Width / 4, _
            Width:=ActiveWindow.Width / 2, _
            Top:=ActiveSheet.Rows(ActiveWindow.ScrollRow).Top + _
                ActiveWindow.Height / 4, _
            Height:=ActiveWindow.Height / 2).Chart

        With chtChart
            .ChartType = xlXYScatterLines

            '' Remove any series created with the chart
            Do Until .SeriesCollection.Count = 0
                .SeriesCollection(1).Delete
            Loop

            For iSrsIx = 1 To iDataRowsCt - 1
            For iSrsIy = 1 To iDataColsCt - 1
                    
                '' Add each series
                Set srsNew = .SeriesCollection.NewSeries
                With srsNew
                    .Name = rngDataSource.Cells(iSrsIx + 1, 1)
                    .Values = rngDataSource.Cells(iSrsIy + 1, 2) _
                        .Resize(1, iDataColsCt - 1)
                    .XValues = rngDataSource.Cells(1, 2) _
                        .Resize(1, iDataColsCt - 1)
                 
                End With
             Next
             Next
        End With
    End If
End Sub

 

[Jon Peltier]

It's an old post, but you're probably still somewhat interested. And that code of mine is much older!

You don't need nested loops, just For iSrsIx = 1 To iDataRowsCt - 1. iSrsIx means Series Index, not something in the x direction, and nothing is needed in the y direction.

Here's the updated code.

Sub MultiY_OneX_Chart()
  
  If Not TypeName(Selection) = "Range" Then
    '' Doesn't work if no range is selected
    MsgBox "Please select a data range and try again.", _
      vbExclamation, "No Range Selected"
  Else
    Dim rngDataSource As Range
    Set rngDataSource = Selection
    With rngDataSource
      Dim iDataRowsCt As Long, iDataColsCt As Long
      iDataRowsCt = .Rows.Count
      iDataColsCt = .Columns.Count
    End With

    '' Create the chart
    Dim chtChart As Chart
    Set chtChart = ActiveSheet.Shapes.AddChart2(, xlXYScatterLines).Chart

    With chtChart
      '' Remove any series created with the chart
      Do Until .SeriesCollection.Count = 0
        .SeriesCollection(1).Delete
      Loop

      Dim iSrsIx As Long
      For iSrsIx = 1 To iDataRowsCt - 1
          '' Add each series
          Dim srsNew As Series
          Set srsNew = .SeriesCollection.NewSeries
          With srsNew
            .Name = rngDataSource.Cells(iSrsIx + 1, 1)
            .Values = rngDataSource.Cells(iSrsIx + 1, 2) _
              .Resize(1, iDataColsCt - 1)
            .XValues = rngDataSource.Cells(1, 2) _
              .Resize(1, iDataColsCt - 1)
          End With
      Next
    End With
  End If
End Sub