Need to create an SPC chart that updates with new data and uses the last 30 cells as range

117 views Asked by At

I need some help with Writing some VBA code that produces a line chart. The chart needs to update when new data is added and I also need the displayed range of data to be the last 30 cells of data. I am having to add this to an existing workbook and have been able to write VBA that displays the already existing data on a chart.

what I have already created

Sub Chartspc()
Dim chrt As ChartObject

Dim r1 As Range
Dim r2 As Range
Dim r3 As Range
Dim r4 As Range

 Set r1 = Sheets("Breather L551").Range("J231:J261")
 Set r2 = Sheets("Breather L551").Range("N231:N261")
 Set r3 = Sheets("Breather L551").Range("R231:R261")
 Set r4 = Sheets("Breather L551").Range("V231:V261")


Set chrt = Sheets("GRAPHTEST").ChartObjects.Add(Left:=0, Width:=600, Top:=0, Height:=300)
chrt.Chart.SetSourceData Source:=Union(r1, r2, r3, r4)
With chrt
.Chart.ChartType = xlLine
.Chart.HasTitle = True
.Chart.ChartTitle.Text = "L551"
.Chart.SetElement (msoElementLegendRight)
.Chart.SeriesCollection(1).Name = "LrA CP"
.Chart.SeriesCollection(2).Name = "LrB CP"
.Chart.SeriesCollection(3).Name = "LrC CP"
.Chart.SeriesCollection(4).Name = "LrD CP"
End With
End Sub

In More detail I want to be able to create a graph from the bottom 30 cells of data I have. I then want new data to be represented on the graph and old data that is outside my 30 cell range removed or not represented on the graph; this would be bottom cell and the 29 cells above it and then everything adjusts down one cell when new data is added.

1

There are 1 answers

5
FaneDuru On BEST ANSWER

Please, test the next code. It will create a chart with series ranges containing the last 30 rows (calculated based on J:J column last row):

Sub Chartspc()
 Dim wsB As Worksheet, wsG As Worksheet, lastR As Long, firstR As Long
 Dim chrt As ChartObject, r1 As Range, r2 As Range, r3 As Range, r4 As Range

 Set wsB = Sheets("Breather L551")
 Set wsG = Sheets("GRAPHTEST")
 lastR = wsB.Range("J" & wsB.rows.count).End(xlUp).row 'J
 If lastR > 31 Then
    firstR = lastR - 29
 Else
   firstR = 2
 End If
 Set r1 = wsB.Range("J" & firstR & ":" & "J" & lastR)
 Set r2 = wsB.Range("N" & firstR & ":" & "N" & lastR)
 Set r3 = wsB.Range("R" & firstR & ":" & "R" & lastR)
 Set r4 = wsB.Range("V" & firstR & ":" & "V" & lastR)

 On Error Resume Next
   wsG.ChartObjects("Chart30Rows").Delete 'delete the chart if it exists
 On Error GoTo 0
 
 Set chrt = wsG.ChartObjects.Add(left:=0, width:=600, top:=0, height:=300)
 chrt.Name = "Chart30Rows"
 chrt.Chart.SetSourceData Source:=Union(r1, r2, r3, r4)
 With chrt
    .Chart.ChartType = xlLine
    .Chart.HasTitle = True
    .Chart.chartTitle.Text = "L551"
    .Chart.SetElement (msoElementLegendRight)
    .Chart.SeriesCollection(1).Name = "LrA CP"
    .Chart.SeriesCollection(2).Name = "LrB CP"
    .Chart.SeriesCollection(3).Name = "LrC CP"
    .Chart.SeriesCollection(4).Name = "LrD CP"
 End With
End Sub

Please, test it and send some feedback. I could not test it...

The code can be adapted to search if the chart already exist and create a new one, if not, or only feed the SeriesCollection with the new ranges, if existing. But not having similar data to test it, it is a little more complicated.