3
\$\begingroup\$

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.

\$\endgroup\$
1
\$\begingroup\$

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

\$\endgroup\$
  • \$\begingroup\$ 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. \$\endgroup\$ – Jean-Pierre Oosthuizen Jan 20 '16 at 7:33

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.