Option Explicit
Option Base 1
Sub SummarizeData()
' ----------------------------
' Declarations
' ----------------------------
' Workbook where data is located.
Dim wsData As Worksheet
' Workbook into which results are place.
Dim wsResults As Worksheet
' Upperleftmost cell where data are located.
Dim rAnchorCellData As Range
' Upperleftmost cell where results are located.
Dim rAnchorCellResults As Range
' Count of rows in the data range.
Dim iDataRowsCount As Long
' Count of rows in results FOR EACH PERSON.
Dim iPersonResultsRowsCount As Long
' Count of rows in results FOR EACH PERSON.
Dim iRowsToClearCount As Long
' For looping through the rows in the data.
Dim iDataRow As Long
' Array that contains all data.
Dim avData() As Variant
' Array used to keep track of the IDs encountered -- one per person.
' "Row" 1 is the ID number, "row" 2 is the name "row" 3 is count of
' data rows for a person
Dim avUniqueIDsFound() As Variant
' Keep track of unique IDs encountered in data.
Dim iUniqueIDsCount As Long
' Used to loop unique IDs array.
Dim iUniqueIDIndex As Long
' String holding the unique ID for a person.
Dim sUniqueID As String
' Used while looping to determine if there is a change of ID
' from one data row to the next.
Dim sCurrentID As String
' Count of rows (entries) to process.
Dim iEntriesCount As Long
' Used for looping through entries.
Dim iEntryIndex As Long
' Used to keep track of the how many rows of data have been processed.
' That is needed to determine the next data row to process relative to
' the data anchor cell rAnchorCellData (e.g. when gathering data for a person.
Dim iDataRowsProcessed As Long
' Used to keep track of which day of the week is being processed 1 - 7.
Dim iOneToSeven As Long
' Used to keep track of how many times there are for a given person
' in a given day. Either two or four. Four if there are two time in and
' time out time stamps for a person in one day.
Dim iOneToFour As Long
' String used to gather time(s) in and time(s) out for a person for a
' given day.
Dim sTimes As String
' Used to determime if the date for the next time in/time out entry
' is the same date as the curren time in/time out entry.
Dim bIsSameDate As Boolean
' Is there a date "missing" for a person in the data meaning that she
' did not work the next day.
Dim bIsSkipDate As Boolean
Dim iDaysMissing As Long
' Count of rows in te data for the person being processed.
Dim iPersonRowsCount As Long
' Date of the data row being processed.
Dim dCurrentDate As Date
' Date of the next bdata row to process.
Dim dNextDate As Date
' ----------------------------
' Initializations
' ----------------------------
Application.ScreenUpdating = False
Set wsData = ThisWorkbook.Worksheets("Sheet1") '<= Name of sheet containg data
Set rAnchorCellData = wsData.Range("B2") '<= (Header) cell where data starts
Set wsResults = ThisWorkbook.Worksheets("Sheet1") '<= Name of sheet containg data
Set rAnchorCellResults = wsResults.Range("G1") '<= cell where results start
iPersonResultsRowsCount = 4 '(e.g., rows 1 through 4 for first person processed.
iDataRowsCount = rAnchorCellData.CurrentRegion.Rows.Count - 1
' Set up array to hold values for 4 "columns".
' Minus one because we skip the header row.
' 1. ID, 2. Name, 3. Date, 4. Time
ReDim avData(1 To 4, 1 To iDataRowsCount)
' Set up array to hold values for 3 "columns".
' 1. ID, 2. Name, 3. Entries Count. One "row"
' for each person.
ReDim avUniqueIDsFound(1 To 3, 1)
' ----------------------------------
' Clear existing results
' ----------------------------------
With rAnchorCellResults
iRowsToClearCount = .Offset(100000).End(xlUp).Row - .Row + 2
.Resize(iRowsToClearCount, 8).Clear
End With
' ----------------------------
' Fill Data Arrays
' ----------------------------
iUniqueIDsCount = 0
Call FillDataArray(rAnchorCellData, iDataRowsCount, avData)
Call FillUniqueIDsArray(rAnchorCellData, avData, avUniqueIDsFound)
iUniqueIDsCount = UBound(avUniqueIDsFound, 2)
' For some reason SOMETIMES the call to funtion FillUniqueIDsArray
' Reports n+1 iUniqueIDsCount. Must decrement the count to
' account for that. Look for an empty array element in "row"
' n+1 to determine if that happened. If there is no "row" n+1
' then this command causes an error.
On Error Resume Next
If avUniqueIDsFound(1, iUniqueIDsCount) = "" Then iUniqueIDsCount = iUniqueIDsCount - 1
On Error GoTo 0
' Resize the array so it has just the right number of "rows."
ReDim Preserve avUniqueIDsFound(1 To 3, iUniqueIDsCount)
' -----------------------------------------------------
' Put Results Labels into the Results Area
' -----------------------------------------------------
For iUniqueIDIndex = 1 To iUniqueIDsCount
' Adds results labels in the results range. NO DATA.
Call CreateLabels( _
avUniqueIDsFound, _
rAnchorCellResults, _
iUniqueIDIndex, _
iPersonResultsRowsCount)
sUniqueID = avUniqueIDsFound(1, iUniqueIDIndex)
Next iUniqueIDIndex
' ----------------------------------------------
' Put Array Data into the Results Area
' ----------------------------------------------
' Used to keep track of how many data rows have been processed. Needed
' to determine the next data row to process relative to the data
' anchor cell rAnchorCellData. To this value is added the iRow number hence
' initialize to zero.
iDataRowsProcessed = 0
' Iterate through all unique IDs found.
For iUniqueIDIndex = 1 To iUniqueIDsCount
' For unique IDs # two to n update the row offset for accessing each
' data row in worksheet data. That value starts at zero for first
' iteration.
If iUniqueIDIndex > 1 _
Then
iDataRowsProcessed = iDataRowsProcessed + avUniqueIDsFound(3, iUniqueIDIndex - 1)
End If
' The count of data rows for the person being processed is in array
' avUniqueIDsFound "column" 3. Row is iUniqueIDIndex
iPersonRowsCount = avUniqueIDsFound(3, iUniqueIDIndex)
' Initialize variable that keeps track of how many days were "skipped"
' for a person being processed for the week being processed.
iDaysMissing = 0
bIsSkipDate = False
' Process all data rows for a person.
For iDataRow = 1 To iPersonRowsCount
' Get the date for the current data row being processed. It is in the
' avData in column 3, row iDataRow + iDataRowsProcessed.
dCurrentDate = avData(3, iDataRow + iDataRowsProcessed)
If iDataRow = iPersonRowsCount _
Then
' If processing the final data row for a given person
' then next date is irrelavant so set it to zero.
dNextDate = 0
Else
dNextDate = avData(3, iDataRow + iDataRowsProcessed + 1)
End If
' Determine if the current date = the next date.
' Set bIsSameDate accordingly, unless it is the last
' data row for the person being processed.
If iDataRow = iPersonRowsCount _
Then
bIsSameDate = False
Else
bIsSameDate = dCurrentDate = dNextDate
End If
' Gather the times for the person-day being processed.
' Add a linefeed character if this is not the first
' time that is being processed.
If Len(sTimes) <> 0 Then sTimes = sTimes & Chr(10)
' Add the next time to the sTimes string variable.
sTimes = sTimes & _
Format(rAnchorCellData.Offset(iDataRowsProcessed + iDataRow, 3).Value, "Short Time")
' Increment counter iOneToFour keeping track of which time row
' is being processed may be two or four (four if there are two
' start times and two end times for a person for a day).
iOneToFour = iOneToFour + 1
' Only record times if the following conditions are met: 1. Not iOneToFour = 1,
' 2. Not iOneToFour = 3 and Not (iOneToFour = 2 And bIsSameDate).
' So process if 1. iOneToFour = 2, and 2. not same date as previous data row being
' processed or 3. iOneToFour = 4.
If Not iOneToFour = 1 And Not iOneToFour = 3 And Not (iOneToFour = 2 And bIsSameDate) _
Then
' Reset the counter keeping track of how many times have been
' encountered for the day being processed.
iOneToFour = 0
' Increment counter that keeps track of which column
' the current day's data is to be placed into.
iOneToSeven = iOneToSeven + 1
' If there was a date skip then adjust iOneToSeven to
' account for the column number by the number of days skipped.
If bIsSkipDate Then iOneToSeven = iOneToSeven + iDaysMissing
' Put the person's hours and date for the date being processed
' into the two cells where that data is placed.
With rAnchorCellResults
' Put the date into the cell in the results area.
With .Offset((iUniqueIDIndex * 4) - 2, iOneToSeven)
.Value = dCurrentDate
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
' Put the times into the cell in the results area.
With .Offset((iUniqueIDIndex * 4) - 1, iOneToSeven)
.Value = sTimes
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
End With
' We saved the times so clear the string variable sTimes
' to prepare for the next date/times pair to process.
sTimes = ""
' Boolean flag bIsSkipDate indicates whether to skip a date (column)
' for the next day's data.
bIsSkipDate = False
If dNextDate - dCurrentDate >= 2 _
Then
bIsSkipDate = True
End If
' If there is a skipped date determine how many days are skipped.
' That value is used in the next iteration to determine how many
' days to skip when putting date and time values into the results area.
If bIsSkipDate _
Then
iDaysMissing = dNextDate - dCurrentDate - 1
Else
iDaysMissing = 0
End If
End If
Next iDataRow
' Set up to process the seven days for the next person.
iOneToSeven = 0
'
Next iUniqueIDIndex
End Sub
