My Code uses a data set which has been modified using another script Calculating Time Difference and then inserts and populates a Chart with that Data.
Save a Macro enabled WorkBook as Book1.xlsm with a Sheet named Book1.
To setup data values for testing copy the data below and paste it to cell B19 in your Excel Sheet named "Book1". and then Use the Text to Columns Function to Delimit it using spaces. The Code should work fine after that.
ORIGINAL DATA DATE SYNCH DURATION
2015/08/01 12:53:02.700 2015/08/01 12:49.002
2015/08/01 17:39:57.520 2015/08/01 00:41.600
2015/08/02 17:39:39.225 2015/08/02 00:27.198
2015/08/03 06:39:59.277 2015/08/03 01:05.600
2015/08/03 15:31:18.520 2015/08/03 01:30.599
2015/08/04 05:15:04.593 2015/08/04 02:29.799
2015/08/05 04:41:48.311 2015/08/05 01:40.199
2015/08/06 05:02:02.023 2015/08/06 01:36.199
2015/08/07 05:02:06.118 2015/08/07 02:16.998
2015/08/07 16:17:51.368 2015/08/07 00:43.401
2015/08/08 17:46:32.678 2015/08/08 00:12.999
2015/08/09 18:01:26.385 2015/08/09 00:41.598
2015/08/10 17:24:19.299 2015/08/10 01:57.797
2015/08/11 06:14:12.158 2015/08/11 00:28.999
2015/08/11 15:26:39.003 2015/08/11 00:07.202
2015/08/12 06:14:14.268 2015/08/12 00:08.600
2015/08/12 15:25:52.311 2015/08/12 03:05.599
2015/08/13 17:37:10.434 2015/08/13 02:04.598
2015/08/14 16:48:52.942 2015/08/14 05:51.401
2015/08/15 18:12:55.861 2015/08/15 02:35.601
2015/08/16 17:13:59.966 2015/08/16 02:02.600
2015/08/17 05:24:38.823 2015/08/17 01:28.400
Paste this code into a Module of the WorkBook. You will get an error if it is pasted into the Sheet Module due to the Function GetTickCount
.
Option Explicit
Public Declare Function GetTickCount Lib "kernel32.dll" () As Long
Sub CreateChart()
' 'Disable Screen Updating
' Application.ScreenUpdating = False
' Application.Calculation = xlCalculationManual
'Normally the DataFileFullPath is set using a FilePicker and the DataFileFullPath, DataFileName, SheetName are all generater in another Sub, its just here to help automate the testing
Dim DataFileFullPath As String
DataFileFullPath = ThisWorkbook.FullName
Dim DataFileName As String, BackSlashPostion As Long
'Finding the start of the File Name with Extension
'by looking for the first \ from the right in DataFileFullPath, eg Unit 31.csv
BackSlashPostion = InStrRev(DataFileFullPath, "\")
DataFileName = Right(DataFileFullPath, Len(DataFileFullPath) - BackSlashPostion)
Dim SheetName As String, FullStopPostion As Long
'Finding the start of the File Name without Extension
'by looking for the first . from the right in DataFileName, eg Unit 31
FullStopPostion = InStrRev(DataFileName, ".")
SheetName = Left(DataFileName, FullStopPostion - 1)
Dim StartTickCount As Long
StartTickCount = GetTickCount
Dim DataWorkSheet As Worksheet
Set DataWorkSheet = Workbooks(DataFileName).Sheets(SheetName)
With DataWorkSheet
Dim LastRow As Long, columnIndex As Long, firstRow As Long
columnIndex = 3 '/ Column "C"
firstRow = 20
LastRow = .Cells(.Rows.Count, columnIndex).End(xlUp).Row
Dim DateRange As Range, TimeRange As Range
'The DataStartRow is set to the ORiginal Time from the T3000
Set DateRange = .Range(.Cells(firstRow, columnIndex + 1), .Cells(LastRow, columnIndex + 1))
Set TimeRange = .Range(.Cells(firstRow, columnIndex + 2), .Cells(LastRow, columnIndex + 2))
End With
Dim RunningTimeChart As Chart
Set RunningTimeChart = Workbooks(DataFileName).Charts.Add
With RunningTimeChart
'The autodata population of the chart is based on the Active Cell when in serting the Chart
'By setting the SourceData to a Blank Cell it then clears the content of the Chart
.SetSourceData (DataWorkSheet.Cells(1, 1))
.ChartType = xlColumnClustered
.SeriesCollection.NewSeries
'=============================================================================================
'Ignore the hiding part, it is just a reference to what happens in another module
'The original data set havs merged cells, which I hide and then the section below allows multiple data from the saem day
'Hiding the Rows from row 2 to end of a TimePeriod to prevent them being displayed in the CHart
'The Chart will display the highest value for a specific date.
'With the Chart.Axes(xlCategory).CategoryType = xlCategoryScale it then displayed everyvalue
'This leads to there being blank entries in the Chart
.Axes(xlCategory).CategoryType = xlCategoryScale
'=============================================================================================
With .SeriesCollection(1)
.Values = TimeRange
.Name = SheetName & " " & "Synch Time"
.XValues = DateRange
End With
.Name = SheetName & " " & "Synch Time Chart"
.Axes(xlValue).MaximumScale = 0.0104166667 ' 15 mins / 50 / 24
.Axes(xlValue).MajorUnit = 0.0006944444 ' 1 mins /60 / 24
'Moving to the Second Sheet in the DataFileName WorkBook
.Move After:=Workbooks(DataFileName).Sheets(2)
End With
Dim EndTickCount As Long
EndTickCount = GetTickCount - StartTickCount
'MsgBox EndTickCount
' 'Enable Screen Updating
' Application.ScreenUpdating = True
' Application.Calculation = xlCalculationAutomatic
End Sub
I think I covered most of the basics for this Module, would like some some peer review.
I am busy looking at how QueryPerformanceCounter works to get more accurate timing.