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

ejpoke

New Member
Joined
Apr 24, 2017
Messages
6
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!
 

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.
Here is a VBA method of presenting the display
Code:
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
 
Upvote 0

Forum statistics

Threads
1,223,885
Messages
6,175,179
Members
452,615
Latest member
bogeys2birdies

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top