Sub ProcessEventDataAndSummarizeAndApplyToAllSheets()
Dim ws As Worksheet
Dim lastRow As Long, lastCol As Long
Dim colSegment As Range, colStart As Range, colEnd As Range
Dim colHidden As Range, colCrewOnly As Range
Dim cell As Range
Dim i As Long
Dim hiddenY As Long, hiddenN As Long
Dim crewY As Long, crewN As Long
Dim dataRange As Range
' Loop through each worksheet in the workbook
For Each ws In ThisWorkbook.Sheets
' Skip specific sheets if needed (e.g., "Summary")
If ws.Name <> "Summary" Then
' Find last row and last column in the sheet
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
' Find important columns
Set colSegment = ws.Rows(1).Find("Segment", LookAt:=xlWhole)
Set colStart = ws.Rows(1).Find("Start Time", LookAt:=xlWhole)
Set colEnd = ws.Rows(1).Find("End Time", LookAt:=xlWhole)
Set colHidden = ws.Rows(1).Find("Hidden", LookAt:=xlWhole)
Set colCrewOnly = ws.Rows(1).Find("Crew Only", LookAt:=xlWhole)
' Insert new columns A:C
ws.Columns("A:C").Insert Shift:=xlToRight
ws.Range("A1").Value = "Segment"
ws.Range("B1").Value = "Start Time"
ws.Range("C1").Value = "End Time"
' Make the header row bold
ws.Rows(1).Font.Bold = True
' Move the data from the original columns to the new columns
If Not colSegment Is Nothing Then
ws.Range(ws.Cells(2, colSegment.Column), ws.Cells(lastRow,
colSegment.Column)).Copy
ws.Cells(2, 1).PasteSpecial Paste:=xlPasteValues
End If
If Not colStart Is Nothing Then
ws.Range(ws.Cells(2, colStart.Column), ws.Cells(lastRow,
colStart.Column)).Copy
ws.Cells(2, 2).PasteSpecial Paste:=xlPasteValues
End If
If Not colEnd Is Nothing Then
ws.Range(ws.Cells(2, colEnd.Column), ws.Cells(lastRow,
colEnd.Column)).Copy
ws.Cells(2, 3).PasteSpecial Paste:=xlPasteValues
End If
Application.CutCopyMode = False ' Clear clipboard
' Remove old columns
On Error Resume Next
If Not colSegment Is Nothing Then colSegment.EntireColumn.Delete
If Not colStart Is Nothing Then colStart.EntireColumn.Delete
If Not colEnd Is Nothing Then colEnd.EntireColumn.Delete
On Error GoTo 0
' Reformat AM/PM in Start Time and End Time columns
For Each cell In ws.Range("B2:B" & lastRow)
If InStr(LCase(cell.Value), "am") > 0 Then
cell.Value = Replace(LCase(cell.Value), "am", " AM")
ElseIf InStr(LCase(cell.Value), "pm") > 0 Then
cell.Value = Replace(LCase(cell.Value), "pm", " PM")
End If
Next cell
For Each cell In ws.Range("C2:C" & lastRow)
If InStr(LCase(cell.Value), "am") > 0 Then
cell.Value = Replace(LCase(cell.Value), "am", " AM")
ElseIf InStr(LCase(cell.Value), "pm") > 0 Then
cell.Value = Replace(LCase(cell.Value), "pm", " PM")
End If
Next cell
' Delete Inventoried and Priced columns if they exist
On Error Resume Next
ws.Rows(1).Find("Inventoried", LookAt:=xlWhole).EntireColumn.Delete
ws.Rows(1).Find("Priced", LookAt:=xlWhole).EntireColumn.Delete
On Error GoTo 0
' Highlight Segment column
For Each cell In ws.Range("A2:A" & lastRow)
Select Case LCase(cell.Value)
Case "hidden", "crew only"
cell.Interior.Color = RGB(169, 169, 169)
Case "entertainment"
cell.Interior.Color = RGB(135, 206, 235)
Case "f & b"
cell.Interior.Color = RGB(128, 0, 128)
Case "spa", "shops", "effy", "art gallery", "watches"
cell.Interior.Color = RGB(255, 0, 0)
End Select
Next cell
' Count Y/N in Hidden and Crew Only
If Not colHidden Is Nothing And Not colCrewOnly Is Nothing Then
For i = 2 To lastRow
Select Case UCase(Trim(ws.Cells(i, colHidden.Column).Value))
Case "Y": hiddenY = hiddenY + 1
Case "N": hiddenN = hiddenN + 1
End Select
Select Case UCase(Trim(ws.Cells(i, colCrewOnly.Column).Value))
Case "Y": crewY = crewY + 1
Case "N": crewN = crewN + 1
End Select
Next i
' Output summary starting at L1
With ws
.Range("L1").Value = "Category"
.Range("M1").Value = "Y Count"
.Range("N1").Value = "N Count"
.Range("L2").Value = "Hidden"
.Range("M2").Value = hiddenY
.Range("N2").Value = hiddenN
.Range("L3").Value = "Crew Only"
.Range("M3").Value = crewY
.Range("N3").Value = crewN
End With
End If
' === Add AutoFilter to the first row ===
If ws.AutoFilterMode Then ws.AutoFilterMode = False
ws.Range(ws.Cells(1, 1), ws.Cells(1, lastCol)).AutoFilter
' === Apply Borders & Adjust Column Width ===
Set dataRange = ws.Range("A1").CurrentRegion
With dataRange.Borders
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
' Auto-fit all columns for better readability
ws.Columns.AutoFit
' Increase row height for better spacing if needed
ws.Rows("1:" & lastRow).RowHeight = 18
End If ' End of sheet exclusion check
Next ws ' Next worksheet
MsgBox "Event Data Processing Complete for all sheets! Headers Bold, Filters,
Borders, and Spacing Applied.", vbInformation
End Sub
