Here's a first shot, but a couple of things are eluding me?
Lots of the details from Timesheet Detail, but which row should I take if there are many entries for a user, wat do I do if there are none?
Public Sub ProcessData()
Const ANOMALIES As String = "Anomalies"
Dim sh As Worksheet
Dim target As Worksheet
Dim aryDates As Variant
Dim dte As Date
Dim NoUser As Boolean
Dim sFormula As String
Dim EvalFormula As String
Dim LastRow As Long
Dim i As Long
Dim j As Long
Set sh = Worksheets("Timesheet Detail")
On Error Resume Next
Set target = Worksheets(ANOMALIES)
On Error GoTo 0
If target Is Nothing Then
Set target = Worksheets.Add(After:=Worksheets(Worksheets.Count))
target.Name = ANOMALIES
End If
target.Cells.ClearContents
With Worksheets("Contingent Staff")
LastRow = .Cells(.Rows.Count, "D").End(xlUp).Row
sFormula = "INDEX(W2:W" & LastRow & ",0,MATCH(<test>,H2:H" & LastRow & ",0))"
For i = 2 To LastRow
dte = .Cells(i, "F").Value
dte = dte + (7 - Weekday(dte, 2))
EvalFormula = Replace(sFormula, "<test>", .Cells(i, "D").Value)
aryDates = Application.Transpose(Application.Evaluate(EvalFormula))
If Not ArrayIsAllocated(aryDates) Then
Do
OutputDetails Worksheets("Contingent Staff"), i, target, dte
dte = dte + 7
Loop Until dte >= .Cells(i, "G").Value + 7
Else
Do
For j = LBound(aryDates) To UBound(aryDates)
If dte = aryDates(j) + (7 - Weekday(aryDates(j), 2)) Then
Exit For
End If
Next j
If j > UBound(aryDates) Then
OutputDetails Worksheets("Contingent Staff"), i, target, dte
End If
dte = dte + 7
Loop Until dte >= .Cells(i, "G").Value + 7
End If
Next i
End With
End Sub
Private Sub OutputDetails(ByRef sh As Worksheet, ByVal SourceRow As Long, _
ByRef target As Worksheet, WeDate As Date)
Static NextRow As Long
With sh
NextRow = NextRow + 1
target.Cells(NextRow, "A").Value = .Cells(SourceRow, "D").Value
target.Cells(NextRow, "B").Value = "??"
target.Cells(NextRow, "C").Value = "??"
target.Cells(NextRow, "D").Value = "??"
target.Cells(NextRow, "E").Value = "??"
target.Cells(NextRow, "F").Value = WeDate
End With
End Sub
Private Function ArrayIsAllocated(Arr As Variant) As Boolean
On Error Resume Next
ArrayIsAllocated = Not (IsError(LBound(Arr))) And _
IsArray(Arr) And (LBound(Arr) <= UBound(Arr))
End Function