Function get_count(date_val As Variant, criteria1 As String, date_header As Range, leader_header As Range)
'Dim criteria1 As String
'Dim date_val As Date
'Dim task_duration_range As Range
'Dim leader_header As Range
'Dim date_header As Range
'date_val = Sheet3.Range("B16")
'criteria1 = "Walk-throughs"
'Set task_duration_range = Sheet8.Range("J2")
'Set date_header = Sheet2.Range("B1")
'Set leader_header = Sheet2.Range("C1")
'Set task_duration_range = task_duration_range.CurrentRegion
'Debug.Print date_val
Dim wr As Range
Dim cell As Range
Dim row_range As Range
'Dim pv As PivotTable
'Set pv = Sheet4.PivotTables("Activities by Team")
'Set wr = pv.RowRange
'Set wr = range_skip_down(wr)
Set wr = expand_down(Sheet4.Range("D3"))
Set wr = range_skip_down(wr)
Dim sum_val As Double
Dim person_coll As New Collection
For Each person In wr
person_coll.Add CStr(person), CStr(person)
Next person
Set wr = expand_down(date_header, True, True)
For Each cell In wr
If IsDate(cell.Value) = True Then
If DateSerial(Year(cell.Value), Month(cell.Value), Day(cell.Value)) = DateSerial(Year(date_val), Month(date_val), Day(date_val)) Then
' check if the leader is the same
If Coll_Exist(person_coll, cell.Offset(0, 1).Value) = True Then
' consider the row
Set row_range = expand_right(cell.Offset(0, 2), True, True)
For Each i In row_range
If LCase(CStr(i.Value)) = LCase(criteria1) Then
sum_val = sum_val + 1
End If
Next i
End If
End If
End If
Next cell
get_count = sum_val
End Function
Function get_hours(date_val As Variant, criteria1 As String, date_header As Range, leader_header As Range)
'Dim criteria1 As String
'Dim date_val As Date
'Dim task_duration_range As Range
'Dim leader_header As Range
'Dim date_header As Range
'date_val = Sheet3.Range("B16")
'criteria1 = "Walk-throughs"
'Set task_duration_range = Sheet8.Range("J2")
'Set date_header = Sheet2.Range("B1")
'Set leader_header = Sheet2.Range("C1")
'Set task_duration_range = task_duration_range.CurrentRegion
'Debug.Print date_val
Dim wr As Range
Dim cell As Range
Dim row_range As Range
' Dim pv As PivotTable
' Set pv = Sheet4.PivotTables("Activities by Team")
' Set wr = pv.RowRange
' Set wr = range_skip_down(wr)
Set wr = expand_down(Sheet4.Range("D3"))
Set wr = range_skip_down(wr)
Dim sum_val As Double
Dim person_coll As New Collection
For Each person In wr
person_coll.Add CStr(person), CStr(person)
Next person
Set wr = expand_down(date_header, True, True)
For Each cell In wr
If IsDate(cell.Value) = True Then
If DateSerial(Year(cell.Value), Month(cell.Value), Day(cell.Value)) = DateSerial(Year(date_val), Month(date_val), Day(date_val)) Then
' check if the leader is the same
If Coll_Exist(person_coll, cell.Offset(0, 1).Value) = True Then
' consider the row
Set row_range = expand_right(cell.Offset(0, 2), True, True)
For Each i In row_range
If LCase(CStr(i.Value)) = LCase(criteria1) Then
If IsNumeric(i.Offset(0, 1).Value) = True Then
sum_val = sum_val + i.Offset(0, 1).Value
End If
End If
Next i
End If
End If
End If
Next cell
get_hours = sum_val
End Function
Sub test()
Dim criteria1 As String
Dim date_val As Date
Dim task_duration_range As Range
Dim leader_header As Range
Dim date_header As Range
date_val = Sheet3.Range("B16")
criteria1 = "Walk-throughs"
Set task_duration_range = Sheet8.Range("J2")
Set date_header = Sheet2.Range("B1")
Set leader_header = Sheet2.Range("C1")
Set task_duration_range = task_duration_range.CurrentRegion
Dim pv As PivotTable
Set pv = Sheet4.PivotTables("Activities by Team")
Dim wr As Range
Dim cell As Range
Dim row_range As Range
Set wr = pv.RowRange
Set wr = range_skip_down(wr)
Dim sum_val As Double
Dim person_coll As New Collection
For Each person In wr
person_coll.Add CStr(person), CStr(person)
Next person
Set wr = expand_down(date_header, True, True)
For Each cell In wr
If IsDate(cell.Value) = True Then
If DateSerial(Year(cell.Value), Month(cell.Value), Day(cell.Value)) = DateSerial(Year(date_val), Month(date_val), Day(date_val)) Then
' check if the leader is the same
If Coll_Exist(person_coll, cell.Offset(0, 1).Value) = True Then
' consider the row
Set row_range = expand_right(cell.Offset(0, 2), True, True)
For Each i In row_range
If i = criteria1 Then
If IsNumeric(i.Offset(0, 1).Value) = True Then
sum_val = sum_val + i.Offset(0, 1).Value
End If
End If
Next i
End If
End If
End If
Next cell
End Sub