Creating a dynamic schedule (one day) based on data base of time punches

[ejpoke]

I currently receive time punch data in the following format over the course of a long date range


[TABLE="width: 500"]
<tbody>[TR]
[TD]Location[/TD]
[TD]Date[/TD]
[TD]Empoyee[/TD]
[TD]In[/TD]
[TD]Out[/TD]
[/TR]
[TR]
[TD]1
[/TD]
[TD]1/1/17[/TD]
[TD]1[/TD]
[TD]8:00[/TD]
[TD]16:00[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]1/1/17[/TD]
[TD]2[/TD]
[TD]9:30[/TD]
[TD]14:00[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]1/1/17[/TD]
[TD]3[/TD]
[TD]9:30[/TD]
[TD]14:35[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]1/1/17[/TD]
[TD]4[/TD]
[TD]10:00[/TD]
[TD]18:07[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]1/1/17[/TD]
[TD]5[/TD]
[TD]7:30[/TD]
[TD]20:00[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]1/1/17[/TD]
[TD]6[/TD]
[TD]8:07[/TD]
[TD]13:04[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]1/1/17[/TD]
[TD]7[/TD]
[TD]11:22[/TD]
[TD]21:30[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]1/1/17[/TD]
[TD]8[/TD]
[TD]9:24[/TD]
[TD]15:56[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]1/1/17[/TD]
[TD]9[/TD]
[TD]8:01[/TD]
[TD]12:54[/TD]
[/TR]
</tbody>[/TABLE]


I'd like to be able to utilize slicers and/or pivot tables to create dynamic charts where the x axis is time (7:00 to 22:00) and the y axis are employee numbers. I'd like horizontal bars to represent the time that they are "clocked in" and for the order to be based off of who clocks in the earliest. so the top most bar is the employee in first and the bottom most bar is the employee in last. This should give me a great visual of how many people are clocked in at the same time and over what period of time.

I understand how to get the duration in hours between two times (Out minus in times 24) but am having trouble setting the axes and plotting those bars.

Anu advice would help!

 

[pbornemeier]

Here is a VBA method of presenting the display

Option Explicit

Sub HourPlot()
    
    'Col A = Location # (1 to 3)
    'Col B = Date
    'Col C = Emp #
    'Col D = In Time
    'Col E = Out Time
    'Row 1 contains headers
    'Row 2 & Down contains data

    Const sWorksheet As String = "Punch Data"
    Const lFirstHourColumn As Long = 7
    Const lFirstHourValue As Long = 7
    Const lLastHourValue As Long = 22
    
    Dim aryColors(1 To 3) As Single
    aryColors(1) = rgbLightBlue
    aryColors(2) = rgbOrange
    aryColors(3) = rgbAqua
    
    Dim shp As Shape
    Dim lLastDataRow As Long
    Dim sngHourWidth As Single
    Dim lRowIndex As Long
    Dim sngBarHeight As Single
    Dim sngBarWidth As Single
    Dim sngBarLeft As Single
    Dim sngBarRight As Single
    Dim sngBarHeightOffset As Single
    Dim sngFractionAfterHourStart As Single
    Dim sngFractionAfterHourEnd As Single
    Dim sngStartOffset As Single
    Dim sngEndOffset As Single
    Dim lStartWholeHourPart As Long
    Dim lEndWholeHourPart As Long
    
    'Should add code to complain if any data hours exceed the above limits
    'Alternately have code use the above as a minimum and expand if data requires
    'Should have code to check if any start or end is missing or if any end is before start
    'Delete Existing bars
    
    For Each shp In ActiveSheet.Shapes
        If Left(shp.Name, 4) = "Row_" Then shp.Delete
    Next
    
    'Sort Data
    With Worksheets(sWorksheet)
        .AutoFilterMode = False
        lLastDataRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=Range("B2:B" & lLastDataRow), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Sort.SortFields.Add Key:=Range("D2:D" & lLastDataRow), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With .Sort
            .SetRange Worksheets(sWorksheet).Range("A1:E" & lLastDataRow)
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With

        'Add Hours
        With .Cells(1, lFirstHourColumn)
            .Value = lFirstHourValue
            .DataSeries Rowcol:=xlRows, Type:=xlLinear, Date:=xlDay, Step:=1, Stop:=lLastHourValue, Trend:=False
        End With
        With .Range(.Cells(1, lFirstHourColumn), .Cells(1, lFirstHourColumn + lLastHourValue - lFirstHourValue))
            .ColumnWidth = 3.14
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
        End With
        
        'Determine width of hour
        sngHourWidth = .Cells(1, lFirstHourColumn).Width
        
        'Plot Times
        For lRowIndex = 2 To lLastDataRow
        
            sngFractionAfterHourStart = 24# * .Cells(lRowIndex, 4) - Int(24# * .Cells(lRowIndex, 4))
            sngStartOffset = sngFractionAfterHourStart * sngHourWidth
            lStartWholeHourPart = Int(24 * .Cells(lRowIndex, 4))
            
            sngFractionAfterHourEnd = 24# * .Cells(lRowIndex, 5) - Int(24# * .Cells(lRowIndex, 5))
            sngEndOffset = sngFractionAfterHourEnd * sngHourWidth
            lEndWholeHourPart = Int(24 * .Cells(lRowIndex, 5))
            
            sngBarLeft = .Cells(1, lStartWholeHourPart).Left + sngStartOffset
            sngBarRight = .Cells(1, lEndWholeHourPart).Left + sngEndOffset
            sngBarWidth = sngBarRight - sngBarLeft
            
            'Define Bar Vertical Parameters...Inside look in case row height changes in table
            sngBarHeight = 0.5 * .Cells(lRowIndex, lFirstHourColumn).Height
            sngBarHeightOffset = 0.5 * .Cells(lRowIndex, lFirstHourColumn).Height / 2
            
            ActiveSheet.Shapes.AddShape(msoShapeRectangle, sngBarLeft, .Cells(lRowIndex, 1).Top + sngBarHeightOffset, sngBarWidth, sngBarHeight).Select
            With Selection.ShapeRange
                .Name = "Row_" & lRowIndex
                
                'Color bars by location
                With .Line
                    .Visible = msoTrue
                    .Weight = 0.25
                    .ForeColor.RGB = aryColors(ActiveSheet.Cells(lRowIndex, 1))
                    .Transparency = 0
                End With
                With .Fill
                    .Visible = msoTrue
                    .ForeColor.RGB = aryColors(ActiveSheet.Cells(lRowIndex, 1))
                    .Transparency = 0
                    .Solid
                End With
                
            End With
        Next
    
    End With
End Sub