Dim aa As IntegerDim StartDate As String
Dim EndDate As String
Dim RngStart As Range
Dim RngEnd As Range
Dim RngStartR As String
Dim RngStartRng As Range
Dim RngEndR As String
Dim RngEndRng As Range
Dim RngXR As String: RngXR = ActiveWorkbook.Sheets("ActiveSheet").Range("C7").value
Dim RngXR2 As String: RngXR2 = ActiveWorkbook.Sheets("ActiveSheet").Range("C8").value
Dim sh As Worksheet
Dim chrt As ChartObject
Dim ch As Chart
Dim zz As Integer
Dim NumObs2 As Long
'ActiveWorkbook.Sheets("AllDistanceMeasures").Range("I:I,J:J").NumberFormat = "0"
'ActiveWorkbook.Sheets("ActiveSheet").Range("E:E").NumberFormat = "0"
NumObs2 = Sheets("AllDistanceMeasures").Cells(Rows.Count, 10).End(xlUp).Row
For aa = 5 To NumObs2
StartDate = Sheets("AllDistanceMeasures").Cells(aa, 9).value
EndDate = Sheets("AllDistanceMeasures").Cells(aa, 10).value
If StartDate <> "" Then
Set RngStart = Sheets("ActiveSheet").Cells.Find(What:=StartDate, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Offset(0, 1)
Else
MsgBox "StartDate variable for " & Sheets("AllDistanceMeasures").Cells(aa, 9).Address & " not found", vbExclamation
Exit Sub
End If
RngStartR = RngStart.Address
If EndDate <> "" Then
Set RngEnd = Sheets("ActiveSheet").Cells.Find(What:=EndDate, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Offset(0, 1)
Else
MsgBox "EndDate variable for " & Sheets("AllDistanceMeasures").Cells(aa, 10).Address & " not found", vbExclamation
Exit Sub
End If
RngEndR = RngEnd.Address
ActiveWorkbook.Sheets("LowDistCharts").Activate
Set sh = Worksheets("LowDistCharts")
Set chrt = sh.ChartObjects.Add(0, 0, 300, 300)
Set ch = chrt.Chart
Do While ch.SeriesCollection.Count > 1
ch.SeriesCollection(1).Delete
Loop
With chrt
.Height = 300
.Width = 300
.Top = 1 + ((aa - 4) * 300)
.Left = 1
End With
With ch
.HasTitle = True
.ChartTitle.Text = aa & " " & StartDate & " to " & EndDate
.ChartTitle.Font.Size = 8
.ChartType = xlLine
.SeriesCollection.NewSeries
.SeriesCollection(1).Values = ActiveWorkbook.Worksheets("ActiveSheet").Range(RngXR, RngXR2)
.SeriesCollection.NewSeries
.SeriesCollection(2).Values = ActiveWorkbook.Worksheets("ActiveSheet").Range(RngStartR, RngEndR)
.SeriesCollection(2).AxisGroup = 2
.SeriesCollection(3).Delete
.HasLegend = False
End With
For zz = 0 To NumObs - 1
Sheets("ActiveSheet").Range(RngEndR).Offset(zz, 0).Copy
Sheets("LowDistCharts").Cells(5, aa + 5).Offset(zz, 0).PasteSpecial xlPasteValues
Next zz
Next aa
