Inserting and Populating Chart with Excel VBA

Question

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.

Answer 1

I'm very appreciative of the instructions and sample data provided so that the macro ran without me needing to figure it all out. +1 just for that, really.

Overall, this seems pretty solid. The only thing you might want to do is use some functions for some of the processes if you use them more than once, which I didn't see. Maybe use a function for getting the names of the workbook and sheet so this sub is strictly creating the chart. Otherwise I don't really have anything negative to say. If you're going to keep the timer in the final version I'd put a comment explaining the need for the library.

I'm consistently at 156 for the timer - pretty quick.

Although I did have a COM add-on that had a fatal error every time I ran the macro until I disabled it. I've attached a screenshot (at the end), though I doubt it will be of any use to you. Maybe if you run into anyone experiencing fatal errors.

(削除) Maybe I'm missing something because of how you do your FilePicker but (I'm sure I am) -

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)

could be accomplished with -

 DataFileName = ThisWorkbook.Name

It gives the extension as well. Same goes for the SheetName. I'm going to assume you're doing this to closed files or something, but I couldn't not mention it. (削除ここまで)

This comment is awesome -

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))

Explaining why something is happening - it's great.

---

Screenshot down here so the answer doesn't look like it's a failure. enter image description here

• Jean-Pierre Oosthuizen: Some great feedback. This Sub is part of a sequence of subs which opens an additional Excel Workbook, deletes blank rows, sums up the maximum time difference between entries with a maximum difference of 30 mins and then finally inserts the Chart based on the maximum times. One of the subs uses the FilePicker to get a FilePath which i then use to get the FileName and SheetName. I added the DataFileFullPath = ThisWorkbook.FullName just for the people testing my code. Since being on CR, I use the timer alto. will definitely add the comment.