Inserting Missing Date in an List with Mutliple EMployees

[raaronrosenc]

I am working on small excel vba program that takes Employee time punches, calculates hours, etc. Problem I am having is inserting missing days for the beginning of month. I need a row for each day of the month. If employee did not have a records for that day a blank row with employee name and date. Following is code I have but I cannot figure out how to get it to add the first day of the month (ie May 1, 2).

User Site Area Date Time In/Out At Door Time In Time Out Hours Worked EOM PEOM
Doe, John DRMS Main Building In 5/3/2016 6:17:11 am EDT D1 FRONT DOOR 6:17:11 AM 2:46:15 PM 8:29 5/31/2016 4/30/2016
Doe, John DRMS Main Building In 5/4/2016 6:19:41 am EDT D1 FRONT DOOR 6:19:41 AM 3:06:14 PM 8:46 5/31/2016 4/30/2016
Doe, John 5/5/2016 4/30/2016
Doe, John 5/6/2016 4/30/2016
Doe, John 5/7/2016 4/30/2016
Doe, John 5/8/2016
Doe, John 5/9/2016
Doe, John DRMS Main Building In 5/10/2016 9:30:04 am EDT D1 FRONT DOOR 9:30:04 AM 3:35:40 PM 6:05 5/31/2016 4/30/2016
Smith, Bob DRMS Main Building In 5/2/2016 7:53:23 am EDT D1 FRONT DOOR 7:53:23 AM 8:50:20 PM 12:56 5/31/2016
Smith, Bob DRMS Main Building In 5/3/2016 8:15:17 am EDT D1 FRONT DOOR 8:15:17 AM 2:47:52 PM 6:32 5/31/2016
Smith, Bob DRMS Main Building In 5/4/2016 9:35:04 am EDT D1 FRONT DOOR 9:35:04 AM 4:45:55 PM 7:10 5/31/2016
Smith, Bob DRMS Main Building In 5/5/2016 7:59:04 am EDT D1 FRONT DOOR 7:59:04 AM 12:22:34 PM 4:23 5/31/2016
Dukas, Phil DRMS Main Building In 5/6/2016 7:55:55 am EDT D1 FRONT DOOR 7:55:55 AM 4:35:27 PM 8:39 5/31/2016




---piece of code using for adding row

'add Missing Days
Dim lastRowIns As Long
Dim curDate As Date
Dim prevDate As Long
Dim xDiff As Long
Dim rowCounter As Long
ActiveWorkbook.Sheets("report").Activate

Dim blkRng As Range

lastRowIns = Cells(Rows.Count, "D").End(xlUp).Row
prevDate = Cells(lastRowIns, "J").Value

'fill in dates at end of month
For rowCounter = lastRowIns To 2 Step -1
curDate = Cells(rowCounter, "D").Value
xDiff = prevDate - curDate
If xDiff > 1 Then
'Add a row
Cells(rowCounter + 1, "D").EntireRow.Resize(xDiff - 1).Insert
End If
prevDate = curDate
Next rowCounter


'Fill in blanks dates
On Error Resume Next
Set blkRng = Range("D:D").SpecialCells(xlCellTypeBlanks)
On Error GoTo 0


If Not blkRng Is Nothing Then
blkRng.FormulaR1C1 = "=R[-1]C+1"
Range("D:D").Copy
Range("D:D").PasteSpecial xlPasteValues

Application.CutCopyMode = False
End If
Range("A1").Select


'Fill in blanks names

On Error Resume Next
Set blkRng = Range("A:A").SpecialCells(xlCellTypeBlanks)
On Error GoTo 0


If Not blkRng Is Nothing Then
blkRng.FormulaR1C1 = "=R[-1]C1"
Range("A:A").Copy
Range("A:A").PasteSpecial xlPasteValues

Application.CutCopyMode = False
End If
Range("A1").Select