vba code to extend graph

[bryanrobson]

Hi everyone.

I have come across this code on the internet. Basically, it extends a graph by a number of positions. Which works great on my existing worksheet. I was just wondering if anyone would be able to amend the code to suit my needs. The code asks how many cells you want to extend the graph by. So, what I want it to do is if I enter 10, I want it to extend the graph at the end by 10, but shorten the graph at the start by 10. or to be prompted for user input to shorten the length by a different amount to how long its extended by.

Many thanks

Sub Chart_Extender()

'PURPOSE: Extend horizontally all Chart Series in ActiveSheet by X number of columns (can decrease as well)

Dim Rng_Extension As Integer
Dim Series_Formula As String
Dim StartPoint As String
Dim EndPoint As String
Dim CommaSplit As Variant
Dim ColonSplit As Variant
Dim grph As ChartObject
Dim ser As Series

'Determine the length of the extension (in cells)
On Error GoTo BadEntry
Rng_Extension = InputBox( _
"How many cells do you want to extend your chart's series?", _
"Chart Extender")
On Error GoTo 0

'Loop Through Each chart in the ActiveSheet
For Each grph In ActiveSheet.ChartObjects
For Each ser In grph.Chart.SeriesCollection

'Test to make sure not XY Scatter Plot Series
If ser.ChartType <> 75 Then
'Get range of series
Series_Formula = ser.Formula

'X Axis Values
CommaSplit = Split(Series_Formula, ",") 'Delimit by comma

ColonSplit = Split(CommaSplit(2), ":") 'Delimit 3rd part by colon

StartPoint = ColonSplit(0) 'Starting Point of Range

EndPoint = ColonSplit(1) 'Current Ending Point Range

EndPoint = Range(EndPoint).Offset(0, Rng_Extension).Address 'Extended Ending Point Range

ser.Values = StartPoint & ":" & EndPoint 'Combine Start and End Point & Set Series = To It

'X Axis Labels
If CommaSplit(1) <> "" Then
ColonSplit = Split(CommaSplit(1), ":") 'Delimit 3rd part by colon

StartPoint = ColonSplit(0) 'Starting Point of Range

EndPoint = ColonSplit(1) 'Current Ending Point Range

EndPoint = Range(EndPoint).Offset(0, Rng_Extension).Address 'Extended Ending Point Range

ser.XValues = StartPoint & ":" & EndPoint 'Combine Start and End Point & Set Series = To It
End If
End If
Next ser
Next grph

'Completion Message
MsgBox "Your chart has been Extended by " & Rng_Extension & " positions."

Exit Sub

'Error Handling
BadEntry:
MsgBox "Your input must be a whole number, aborting", vbCritical, "Improper Entry"

End Sub

 

[bryanrobson]

I've managed to figure this out myself. My coding may not be the best as I've picked this up myself. The code basically only works on the active sheet selected and asks you to enter the number you want to reduce the graph / start of the range by and extend the end of the graph / range. This also works with negative figures. The only point to note, is the sheet cannot have a space in the worksheet name. So weeklyreport or weekly_report will work, but weekly report wont.

Option Explicit

Sub Chart_Extender()

'PURPOSE: Extend horizontally all Chart Series in ActiveSheet by X number of columns (can decrease as well)

Dim Rng_Extension As Integer
Dim Rng_Reduction As Integer
Dim Series_Formula As String
Dim StartPoint As String
Dim EndPoint As String
Dim CommaSplit As Variant
Dim ColonSplit As Variant
Dim grph As ChartObject
Dim ser As Series
Dim SheetName As String
Dim ColumnNumber As Long
Dim ColumnLetter As String
Dim Row As Long
Dim RowArray() As String
Dim NewStartPoint As String

Application.ScreenUpdating = False       'helps macro run faster
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False        'helps macro run faster
Application.EnableEvents = False         'helps macro run faster
Application.DisplayStatusBar = False     'helps macro run faster
ActiveSheet.DisplayPageBreaks = False    'helps macro run faster

SheetName = ActiveSheet.Name


'Determine the length of the extension (in cells)
  On Error GoTo BadEntry
 
  Rng_Reduction = InputBox( _
      "How many cells do you want to reduce your chart's series?", _
      "Chart Extender")
 
 
    Rng_Extension = InputBox( _
      "How many cells do you want to extend your chart's series?", _
      "Chart Extender")
     
   
     
  On Error GoTo 0
   
'Loop Through Each chart in the ActiveSheet
  For Each grph In ActiveSheet.ChartObjects
    For Each ser In grph.Chart.SeriesCollection
   
      'Test to make sure not XY Scatter Plot Series
        If ser.ChartType <> 75 Then
          'Get range of series
            Series_Formula = ser.Formula
                       
          'X Axis Values
            CommaSplit = Split(Series_Formula, ",") 'Delimit by comma
            ColonSplit = Split(CommaSplit(2), ":")  'Delimit 3rd part by colon
            StartPoint = ColonSplit(0)  'Starting Point of Range
           
            RowArray = Split(StartPoint, "$")
            Row = RowArray(2)
            
            ColumnNumber = Range(StartPoint).Column
        
            ColumnNumber = ColumnNumber + Rng_Reduction
          
            ColumnLetter = Split(Cells(1, ColumnNumber).Address, "$")(1)
                      
            NewStartPoint = SheetName & "!" & "$" & ColumnLetter & "$" & Row
                       
            EndPoint = ColonSplit(1)    'Current Ending Point Range
                       
            EndPoint = Range(EndPoint).Offset(0, Rng_Extension).Address 'Extended Ending Point Range
                       
           
           
            ser.Values = NewStartPoint & ":" & EndPoint 'Combine Start and End Point & Set Series = To It
       
          'X Axis Labels
            If CommaSplit(1) <> "" Then
                           
              ColonSplit = Split(CommaSplit(1), ":")  'Delimit 3rd part by colon
           
              StartPoint = ColonSplit(0)  'Starting Point of Range
                             
              RowArray = Split(StartPoint, "$")
                           
              Row = RowArray(2)
                          
              ColumnNumber = Range(StartPoint).Column
                           
              ColumnNumber = ColumnNumber + Rng_Reduction
              ColumnLetter = Split(Cells(1, ColumnNumber).Address, "$")(1)
                           
              NewStartPoint = SheetName & "!" & "$" & ColumnLetter & "$" & Row
                           
              EndPoint = ColonSplit(1)    'Current Ending Point Range
             
              EndPoint = Range(EndPoint).Offset(0, Rng_Extension).Address  'Extended Ending Point Range
   
              ser.XValues = NewStartPoint & ":" & EndPoint 'Combine Start and End Point & Set Series = To It
            End If
        End If
    Next ser
   
  
  Next grph

'Completion Message
    MsgBox "Your chart has been Reduced by " & Rng_Reduction & " positions " & "and extended by " & Rng_Extension & " positions"

Exit Sub

'Error Handling
BadEntry:
  MsgBox "Your input must be a whole number, aborting", vbCritical, "Improper Entry"

Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.DisplayStatusBar = True
ActiveSheet.DisplayPageBreaks = True


End Sub