PDA

View Full Version : [SOLVED:] Help to create a date range chart based on a date wthin the data



blackie42
12-16-2016, 08:29 AM
Hi,

So to explain - on sheet2 I would have a rolling range of (working) dates in col A with corresponding values col B

e.g.

03/01/2017 £50,000
04/01/2017 £49,000
05/01/2017 £49,500
06/01/2017 £51,025
09/01/2017 £50,500
10/01/2017 £49,500
11/01/2017 £49,000

On sheet1 I would input 11/01/2017 in e.g. A1 and the chart on same sheet would automatically adjust to pick up the last 5 dates (inc 11/01/2017 with values) giving me a rolling picture of the values over the last 5 working days

Any ideas how to achieve this?

many thanks
Jon

mana
12-16-2016, 05:34 PM
Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address <> "$A$1" Then Exit Sub

With ChartObjects(1).Chart.Axes(xlCategory)
.MinimumScale = Target.Value2
.MaximumScale = WorksheetFunction.WorkDay(Target, 4)
End With

End Sub

p45cal
12-16-2016, 08:33 PM
Change the date in A1 of Sheet1 in the attached.
Sheet1's code-module contains:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo myExit
If Not Intersect(Range("A1"), Target) Is Nothing Then
With Sheets("Sheet2")
x = Application.Match(Range("A1"), Sheets("Sheet2").Range("A:A"))
Set xvals = .Range(.Cells(Application.Max(2, x - 4), "A"), .Cells(x, "A"))
' Application.Goto xvals
' Application.Goto Range("A2")
With ChartObjects("Chart 1").Chart
.SeriesCollection(1).XValues = xvals
.SeriesCollection(1).Values = xvals.Offset(, 1)
End With
End With
End If
Exit Sub
myExit:
MsgBox "There was an error"
End Sub

blackie42
12-17-2016, 03:05 AM
Thanks Guys,

This forum rocks! P45 full solution just the job.

regards
Jon

blackie42
12-17-2016, 12:18 PM
Hi P45

I need to add more graphs to sheet1 using same kind of information in sheet3 etc

Had a go at replicating the code and adding blank chart2 but struggling - could you help further please

many thanks
Jon

p45cal
12-17-2016, 12:45 PM
Supply a file.

blackie42
12-18-2016, 07:44 AM
Hi again,

Mamy thanks for help

So 3 graphs -each linked to different sheets

regards
Jon

p45cal
12-18-2016, 11:43 AM
see attached.

blackie42
12-18-2016, 01:10 PM
Brilliant stuff P45 - much appreciated.

I popped the following in after chart 2 code and seems to work reformatting the series 1 & 2 to Money In & Out


ChartObjects("Chart 2").Chart.SeriesCollection(1).Name = "=""Money In"""
ChartObjects("Chart 2").Chart.SeriesCollection(2).Name = "=""Money Out"""
regards
Jon

p45cal
12-19-2016, 04:47 AM
Ah yes, I missed that one.
.Name = "=""Money In""" can be shortened to .Name = "Money In".
Better:
ChartObjects("Chart 2").Chart.SetSourceData Source:=xvals.Resize(, 3)
ChartObjects("Chart 2").Chart.SeriesCollection(1).Name = "=""Money In"""
ChartObjects("Chart 2").Chart.SeriesCollection(2).Name = "=""Money Out"""
can be:
With ChartObjects("Chart 2").Chart
.SetSourceData Source:=xvals.Resize(, 3)
.SeriesCollection(1).Name = "Money In"
.SeriesCollection(2).Name = "Money Out"
End With

blackie42
12-20-2016, 03:56 AM
Hi P45,

Sorry to bother you again - I really could do with protecting Sheet1 (apart from A1 of course) but in doing this changing the date creates a code crash


With ChartObjects("Chart 1").Chart
.SeriesCollection(1).XValues = xvals *** code stops here
.SeriesCollection(1).Values = xvals.Offset(, 1)

Any chance of a workround?
thanks
Jon

p45cal
12-20-2016, 05:25 AM
Add the line in bold:
If Not Intersect(Range("A1"), Target) Is Nothing Then
Me.Protect userinterfaceonly:=True, DrawingObjects:=False
Come back if you're using a password.

blackie42
12-20-2016, 12:37 PM
Still getting the Run-time error 2147467259(80004005)

Method 'XValues of object 'Series' failed

Sheet gets protected but values don't update.

re-enabling the error statement to 'on error resume next' updates chart 2 but not 1 or 3

p45cal
12-20-2016, 12:46 PM
Attach the file.

blackie42
12-20-2016, 03:02 PM
attached..

p45cal
12-20-2016, 05:05 PM
Take out the On Error, unlock cell A1, try again. See attached.

blackie42
12-21-2016, 02:21 AM
Many thanks for your help - works now.

regards
Jon