Adjust AutoPlot Code to Create New Sheet Then Process

M

MylesMc

New member
Joined
Aug 14, 2013
Messages
13
Reaction score
0
Points
0
Hey Guys,

The code below represents a function to autoplot data in the attached spreadsheet. However, it only works if I have 1 blank chart inserted into the spreadsheet. What I would like is to have this code just create a new chart, despite if there are other charts already on the sheet (and just leave them alone).

The AutoPlot code I have is the following:

Sub blah()
Range("A1").Select 'in case the chart is selected.
Range("A1").Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3), Replace:=True, PageBreaks:=False, SummaryBelowData:=True
With ActiveSheet.ChartObjects("Chart 1").Chart
'delete all existing series first:
For i = 1 To .SeriesCollection.Count
.SeriesCollection(1).Delete
Next i
For Each ar In Intersect(ActiveSheet.UsedRange, Columns("B:B")).Offset(1).SpecialCells(xlCellTypeConstants, 23).Areas
' ar.Offset(, -1).Resize(, 3).Select
' ar.Cells(1).Offset(, -1).Select
' ar.Columns(1).Select
' ar.Columns(2).Select
With .SeriesCollection.NewSeries
.XValues = ar.Columns(1)
.Values = ar.Columns(2)
.Name = ar.Cells(1).Offset(, -1)
With .Border
.Weight = xlThin
.LineStyle = xlAutomatic
.ColorIndex = xlAutomatic
End With
.MarkerStyle = xlNone
.Smooth = True
End With
Next ar
End With
Range("A1").RemoveSubtotal
End Sub

Any and all help is appreciated immensely,
Myles Mc
 

Attachments

  • Excel Guru AutoPlot.xlsm
    137.5 KB · Views: 18
Code: 
Sub blah2()
Range("A1").Select  'in case the chart is selected.
Range("A1").Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3), Replace:=True, PageBreaks:=False, SummaryBelowData:=True
xx = ActiveSheet.ChartObjects.Count
If xx > 0 Then
  With ActiveSheet.ChartObjects(xx) 'position new chart relative to previous one:
    L = .Left + 10: T = .Top + 10: W = .Width: H = .Height
  End With
Else 'no chart previously on sheet
  L = 240: T = 30: W = 740: H = 500
End If
With ActiveSheet.ChartObjects.Add(L, T, W, H).Chart
  .ChartType = xlXYScatterLinesNoMarkers
  .Axes(xlValue).MinimumScale = 719
  .Axes(xlCategory).MaximumScale = 700
  For Each ar In Intersect(ActiveSheet.UsedRange, Columns("B:B")).Offset(1).SpecialCells(xlCellTypeConstants, 23).Areas
    With .SeriesCollection.NewSeries
      .XValues = ar.Columns(1)
      .Values = ar.Columns(2)
      .Name = ar.Cells(1).Offset(, -1)
      With .Border
        .Weight = xlThin
        .LineStyle = xlAutomatic
        .ColorIndex = xlAutomatic
      End With
      .MarkerStyle = xlNone
      .Smooth = True
    End With
  Next ar
End With
Range("A1").RemoveSubtotal
End Sub
 
This works great, thanks so much!

Now I am wondering, how the code would need to be changed if different arrays were needed. For example, if I had a table with headers in row 5, so the data starts in row 6. The table is in columns S:AB, and I want to plot the values in the first column (S represents the title and data for each line) and the last two columns (AA on the y axis and AB on the x axis) of the table as shown in the attached excel sheet.

Once again, any help is appreciated.
 

Attachments

  • Excel Guru Autoplot 2a.xlsx
    178.6 KB · Views: 15
Code: 
Sub blah3()
Range("S5").Select  'in case the chart is selected.
Range("S5").Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3), Replace:=True, PageBreaks:=False, SummaryBelowData:=True
xx = ActiveSheet.ChartObjects.Count
If xx > 0 Then
  With ActiveSheet.ChartObjects(xx)  'position and size new chart relative to previous one:
    L = .Left + 10: T = .Top + 10: W = .Width: H = .Height
  End With
Else  'no chart previously on sheet
  L = 240: T = 30: W = 740: H = 500
End If
With ActiveSheet.ChartObjects.Add(L, T, W, H).Chart
  .ChartType = xlXYScatterLinesNoMarkers
'.Axes(xlValue).MinimumScale = 719
'.Axes(xlCategory).MaximumScale = 700
  For Each ar In Range("S5").CurrentRegion.Columns("B:B").Offset(2).SpecialCells(xlCellTypeConstants, 23).Areas
    With .SeriesCollection.NewSeries
      .XValues = ar.Columns(9)
      .Values = ar.Columns(8)
      .Name = ar.Cells(1).Offset(, -1)
      With .Border
        .Weight = xlThin
        .LineStyle = xlAutomatic
        .ColorIndex = xlAutomatic
      End With
      .MarkerStyle = xlNone
      .Smooth = True
    End With
  Next ar
End With
Range("S5").RemoveSubtotal
End Sub
 
Oh yehhh, this looks awesome! Thank you very much. Excellent Work!

I was messing around with it trying to do it myself, but I was also changing the ("B:B") in the following code:

For Each ar In Range("S5").CurrentRegion.Columns("B:B").Offset(2).SpecialCells(xlCellTypeConstants, 23).Areas
With .SeriesCollection.NewSeries

Would you mind explaining why the CurrentRegion.Columns("B:B") is unchanged between your two posts?
 
Because the Columns("B:B") is relative to the CurrentRegion.
In the older code it was relative to the whole sheet.

range("C3").Range("c3").Select

selects cell E5!
 
Last edited:
You must log in or register to reply here.
Back
Top