Option Explicit

Const T1_Col_New_Mach_No As String = "A"
Const T1_Col_Serial As String = "B"
Const T1_Col_Location As String = "C"
Const T1_Col_Frequency_of_Collection As String = "D"
Const T1_Col_1_Dollard As String = "E"
Const T1_Col_50_Cents As String = "F"
Const T1_Col_25_Cents As String = "G"
Const T1_Col_20_Cents As String = "H"
Const T1_Col_10_Cents As String = "I"
Const T1_Col_5_Cents As String = "J"
Const T1_Col_Subtotal As String = "K"

Const MIS_Col_Date As String = "B"
Const MIS_Col_No_of_machines As String = "C"
Const MIS_Col_Total_Counted As String = "D"
Const MCS_Col_New_Mach_No As String = "H"
Const MCS_Col_Serial As String = "I"
Const MCS_Col_Old_Match_No As String = "J"
Const MCS_Col_Location As String = "K"
Const MCS_Col_Frequency_of_Collection As String = "L"
Const MCS_Col_1_Dollard As String = "M"
Const MCS_Col_50_Cents As String = "N"
Const MCS_Col_25_Cents As String = "O"
Const MCS_Col_20_Cents As String = "P"
Const MCS_Col_10_Cents As String = "Q"
Const MCS_Col_5_Cents As String = "R"
Const MCS_Col_Subtotal As String = "S"

Const DS_Col_New_Mach_No As String = "A"
Const DS_Col_Serial As String = "B"
Const DS_Col_Location As String = "C"
Const DS_Col_1_Dollard As String = "E"
Const DS_Col_50_Cents As String = "F"
Const DS_Col_25_Cents As String = "G"
Const DS_Col_20_Cents As String = "H"
Const DS_Col_10_Cents As String = "I"
Const DS_Col_5_Cents As String = "J"
Const DS_Col_Subtotal As String = "K"

Public Sub Create_Summary_Collection_Sheet()

Dim DayNumber As Long
Dim DS As Worksheet

Dim i As Long
Dim iRow As Long
Dim iRow_MCS As Long
Dim iLastRow As Long
Dim iFirstRow_MCS As Long
Dim iLastRow_MCS As Long
Dim iLastRow_T1 As Long
Dim iSheet As Long
Dim iFirstRowLocation As Long

Dim ArrayMonths() As String
ArrayMonths = Split("Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec", ",")
Dim ArrayDaysMonth() As Variant
ArrayDaysMonth = Array(31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)

Dim Prev_Location As String
Dim SC As Worksheet
Dim T1 As Worksheet
Dim T1_NextRow As Long
Dim WordArray() As String

Set SC = ActiveSheet

WordArray() = Split(Worksheets(2).Name)
If CInt(WordArray(3)) Mod 4 = 0 Then ArrayDaysMonth(1) = 29

For i = 0 To 11
If Mid(WordArray(2), 1, 3) = ArrayMonths(i) Then Exit For
Next i

For iRow = 5 To ArrayDaysMonth(i) + 4

SC.Range(MIS_Col_Date & iRow & ":" & MIS_Col_Total_Counted & iRow).Select
Selection.ClearContents

DayNumber = iRow - 4

If DayNumber < 10 Then
SC.Range(MIS_Col_Date & iRow) = "0" & DayNumber & "-" & WordArray(2)
Else
SC.Range(MIS_Col_Date & iRow) = DayNumber & "-" & WordArray(2)
End If

Next iRow

iLastRow_MCS = ActiveSheet.Cells(Rows.Count, MCS_Col_Location).End(xlUp).Row

For iRow_MCS = 4 To 5

SC.Range(MCS_Col_New_Mach_No & iRow_MCS & ":" & MCS_Col_Subtotal & iRow_MCS).Select
Selection.ClearContents

Next iRow_MCS

For iRow_MCS = iLastRow_MCS - 1 To 6 Step -1

SC.Range(MCS_Col_New_Mach_No & iRow_MCS & ":" & MCS_Col_Subtotal & iRow_MCS).Select
Selection.Delete

Next iRow_MCS

Worksheets.Add
ActiveSheet.Name = "Temp"

Set T1 = ActiveSheet

T1_NextRow = 1

' Scan all sheets (excluding SUMMARY COLLECTION sheet)
' Ignore sheets with "Old" in their name
' For each other sheet call Update_SUMMARY_COLLECTION_Sheet

SC.Activate
For iSheet = 3 To Worksheets.Count Step 1

WordArray() = Split(Worksheets(iSheet).Name)

'MsgBox UBound(WordArray())
'MsgBox Worksheets(iSheet).Name
If WordArray(3) <> "Old" Then
If IsNumeric(Mid(WordArray(1), 1, 2)) Then
DayNumber = CInt(Mid(WordArray(1), 1, 2))
Else
DayNumber = CInt(Mid(WordArray(1), 1, 1))
End If
Set DS = Worksheets(iSheet)

Call Update_SUMMARY_COLLECTION_Sheet(SC, DayNumber, DS, T1, T1_NextRow)
End If

Next iSheet

T1.Activate
iLastRow_T1 = ActiveSheet.Cells(Rows.Count, T1_Col_Location).End(xlUp).Row

Cells.Select
ActiveWorkbook.Worksheets("Temp").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Temp").Sort.SortFields.Add Key _
:=Range(T1_Col_Location & "1:" & T1_Col_Location & iLastRow_T1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
ActiveWorkbook.Worksheets("Temp").Sort.SortFields.Add Key _
:=Range(T1_Col_New_Mach_No & "1:" & T1_Col_New_Mach_No & iLastRow_T1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
ActiveWorkbook.Worksheets("Temp").Sort.SortFields.Add Key _
:=Range(T1_Col_Serial & "1:" & T1_Col_Serial & iLastRow_T1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
With ActiveWorkbook.Worksheets("Temp").Sort
.SetRange Range(T1_Col_New_Mach_No & "1:" & T1_Col_Location & iLastRow_T1)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

T1.Activate
Prev_Location = ""
iFirstRowLocation = 1
iLastRow_T1 = ActiveSheet.Cells(Rows.Count, T1_Col_Location).End(xlUp).Row

For iRow = 2 To iLastRow_T1

If iRow > iLastRow_T1 Then Exit For

If T1.Range(T1_Col_Location & iRow) <> Prev_Location Then

Prev_Location = T1.Range(T1_Col_Location & iRow)
iFirstRowLocation = iFirstRowLocation + 1

Else

T1.Range(T1_Col_Frequency_of_Collection & iFirstRowLocation) = T1.Range(T1_Col_Frequency_of_Collection & iFirstRowLocation) + T1.Range(T1_Col_Frequency_of_Collection & iRow)
T1.Range(T1_Col_1_Dollard & iFirstRowLocation) = T1.Range(T1_Col_1_Dollard & iFirstRowLocation) + T1.Range(T1_Col_1_Dollard & iRow)
T1.Range(T1_Col_50_Cents & iFirstRowLocation) = T1.Range(T1_Col_50_Cents & iFirstRowLocation) + T1.Range(T1_Col_50_Cents & iRow)
T1.Range(T1_Col_25_Cents & iFirstRowLocation) = T1.Range(T1_Col_25_Cents & iFirstRowLocation) + T1.Range(T1_Col_25_Cents & iRow)
T1.Range(T1_Col_20_Cents & iFirstRowLocation) = T1.Range(T1_Col_20_Cents & iFirstRowLocation) + T1.Range(T1_Col_20_Cents & iRow)
T1.Range(T1_Col_10_Cents & iFirstRowLocation) = T1.Range(T1_Col_10_Cents & iFirstRowLocation) + T1.Range(T1_Col_10_Cents & iRow)
T1.Range(T1_Col_5_Cents & iFirstRowLocation) = T1.Range(T1_Col_5_Cents & iFirstRowLocation) + T1.Range(T1_Col_5_Cents & iRow)
T1.Range(T1_Col_Subtotal & iFirstRowLocation) = T1.Range(T1_Col_Subtotal & iFirstRowLocation) + T1.Range(T1_Col_Subtotal & iRow)
T1.Range("A" & iRow).EntireRow.Delete
iRow = iRow - 1
iLastRow_T1 = iLastRow_T1 - 1

End If

Next iRow

iFirstRow_MCS = 4
SC.Activate
iLastRow_MCS = ActiveSheet.Cells(Rows.Count, MCS_Col_New_Mach_No).End(xlUp).Row

iRow_MCS = iFirstRow_MCS

For iRow = 2 To iLastRow_T1

If iRow_MCS = iLastRow_MCS - 1 Then
SC.Range(MCS_Col_New_Mach_No & iLastRow_MCS - 1 & ":" & MCS_Col_Subtotal & iLastRow_MCS - 1).Select
Selection.Insert CopyOrigin:=xlFormatFromLeftOrAbove
iLastRow_MCS = iLastRow_MCS + 1
End If

SC.Range(MCS_Col_New_Mach_No & iRow_MCS) = T1.Range(T1_Col_New_Mach_No & iRow)
SC.Range(MCS_Col_Serial & iRow_MCS) = T1.Range(T1_Col_Serial & iRow)
'SC.Range(MCS_Col_Old_Mach_No & iRow_MCS) = T1.Range(T1_Col_Old_Mach_No & iRow)
SC.Range(MCS_Col_Location & iRow_MCS) = T1.Range(T1_Col_Location & iRow)
SC.Range(MCS_Col_Frequency_of_Collection & iRow_MCS) = T1.Range(T1_Col_Frequency_of_Collection & iRow)
SC.Range(MCS_Col_1_Dollard & iRow_MCS) = T1.Range(T1_Col_1_Dollard & iRow)
SC.Range(MCS_Col_50_Cents & iRow_MCS) = T1.Range(T1_Col_50_Cents & iRow)
SC.Range(MCS_Col_25_Cents & iRow_MCS) = T1.Range(T1_Col_25_Cents & iRow)
SC.Range(MCS_Col_20_Cents & iRow_MCS) = T1.Range(T1_Col_20_Cents & iRow)
SC.Range(MCS_Col_10_Cents & iRow_MCS) = T1.Range(T1_Col_10_Cents & iRow)
SC.Range(MCS_Col_5_Cents & iRow_MCS) = T1.Range(T1_Col_5_Cents & iRow)
SC.Range(MCS_Col_Subtotal & iRow_MCS) = T1.Range(T1_Col_Subtotal & iRow)
iRow_MCS = iRow_MCS + 1

Next iRow

Application.DisplayAlerts = False
Worksheets("Temp").Delete
Application.DisplayAlerts = True
End Sub

Private Sub Update_SUMMARY_COLLECTION_Sheet(SC As Worksheet, DayNumber As Long, DS As Worksheet, T1 As Worksheet, T1_NextRow As Long)

Dim iRow
Dim iLastRow_DS As Long

DS.Activate
iLastRow_DS = ActiveSheet.Cells(Rows.Count, DS_Col_Serial).End(xlUp).Row

If T1_NextRow = 1 Then

T1.Range(T1_Col_New_Mach_No & 1) = "New Mach No."
T1.Range(T1_Col_Serial & 1) = "Serial"
T1.Range(T1_Col_Location & 1) = "Location"
T1.Range(T1_Col_Frequency_of_Collection & 1) = "Frequency of Collection"
T1.Range(T1_Col_1_Dollard & 1) = "$1"
T1.Range(T1_Col_50_Cents & 1) = "50c"
T1.Range(T1_Col_25_Cents & 1) = "25c"
T1.Range(T1_Col_20_Cents & 1) = "20c"
T1.Range(T1_Col_10_Cents & 1) = "10c"
T1.Range(T1_Col_5_Cents & 1) = "5c"
T1.Range(T1_Col_Subtotal & 1) = "Subtotal"
T1_NextRow = T1_NextRow + 1

End If

For iRow = 4 To iLastRow_DS - 1

DS.Activate
DS.Range(DS_Col_New_Mach_No & iRow).Select
T1.Range(T1_Col_New_Mach_No & T1_NextRow) = DS.Range(DS_Col_New_Mach_No & iRow)
T1.Range(T1_Col_Serial & T1_NextRow) = DS.Range(DS_Col_Serial & iRow)
T1.Range(T1_Col_Location & T1_NextRow) = DS.Range(DS_Col_Location & iRow)
T1.Range(T1_Col_Frequency_of_Collection & T1_NextRow) = 1
T1.Range(T1_Col_1_Dollard & T1_NextRow) = DS.Range(DS_Col_1_Dollard & iRow)
T1.Range(T1_Col_50_Cents & T1_NextRow) = DS.Range(DS_Col_50_Cents & iRow)
T1.Range(T1_Col_25_Cents & T1_NextRow) = DS.Range(DS_Col_25_Cents & iRow)
T1.Range(T1_Col_20_Cents & T1_NextRow) = DS.Range(DS_Col_20_Cents & iRow)
T1.Range(T1_Col_10_Cents & T1_NextRow) = DS.Range(DS_Col_10_Cents & iRow)
T1.Range(T1_Col_5_Cents & T1_NextRow) = DS.Range(DS_Col_5_Cents & iRow)
T1.Range(T1_Col_Subtotal & T1_NextRow) = DS.Range(DS_Col_Subtotal & iRow)
T1.Activate
T1_NextRow = T1_NextRow + 1
Next iRow

SC.Range(MIS_Col_No_of_machines & DayNumber + 4) = iLastRow_DS - 4
SC.Range(MIS_Col_Total_Counted & DayNumber + 4) = DS.Range(DS_Col_Subtotal & iLastRow_DS)
End Sub