Sub ProcessEventData()
Dim ws As Worksheet
Dim lastRow As Long
Dim colSegment As Range, colStart As Range, colEnd As Range
Dim cell As Range
' Set worksheet to active sheet
Set ws = ActiveSheet
' Find last row in the sheet
lastRow = [Link]([Link], 1).End(xlUp).Row
' Find original columns for Segment, Start Time, End Time
Set colSegment = [Link](1).Find("Segment", LookAt:=xlWhole)
Set colStart = [Link](1).Find("Start Time", LookAt:=xlWhole)
Set colEnd = [Link](1).Find("End Time", LookAt:=xlWhole)
' Insert new columns for Segment, Start Time, End Time at the beginning (shift
existing columns to the right)
[Link]("A:C").Insert Shift:=xlToRight
' Set headers for new columns
[Link]("A1").Value = "Segment"
[Link]("B1").Value = "Start Time"
[Link]("C1").Value = "End Time"
' Move the data from the original columns to the new columns (starting from row
2, avoid headers)
If Not colSegment Is Nothing Then
[Link]([Link](2, [Link]), [Link](lastRow,
[Link])).Copy
[Link](2, 1).PasteSpecial Paste:=xlPasteValues
End If
If Not colStart Is Nothing Then
[Link]([Link](2, [Link]), [Link](lastRow,
[Link])).Copy
[Link](2, 2).PasteSpecial Paste:=xlPasteValues
End If
If Not colEnd Is Nothing Then
[Link]([Link](2, [Link]), [Link](lastRow, [Link])).Copy
[Link](2, 3).PasteSpecial Paste:=xlPasteValues
End If
[Link] = False ' Clear the clipboard to prevent flickering
' Now remove the old "Segment", "Start Time", "End Time" columns to avoid
duplication
On Error Resume Next
If Not colSegment Is Nothing Then [Link]
If Not colStart Is Nothing Then [Link]
If Not colEnd Is Nothing Then [Link]
On Error GoTo 0
' Format Start Time and End Time to add space between numbers and AM/PM
For Each cell In [Link]("B2:B" & lastRow)
If InStr([Link], "am") > 0 Then
[Link] = Replace([Link], "am", " AM")
ElseIf InStr([Link], "pm") > 0 Then
[Link] = Replace([Link], "pm", " PM")
End If
Next cell
For Each cell In [Link]("C2:C" & lastRow)
If InStr([Link], "am") > 0 Then
[Link] = Replace([Link], "am", " AM")
ElseIf InStr([Link], "pm") > 0 Then
[Link] = Replace([Link], "pm", " PM")
End If
Next cell
' Delete Inventoried and Priced columns if they exist
On Error Resume Next
[Link](1).Find("Inventoried", LookAt:=xlWhole).[Link]
[Link](1).Find("Priced", LookAt:=xlWhole).[Link]
On Error GoTo 0
' Apply coloring only to the Segment column based on specific criteria
For Each cell In [Link]("A2:A" & lastRow)
Select Case True
' Gray color for "hidden" and "crew only" events in Segment
Case LCase([Link]) Like "hidden", LCase([Link]) Like "crew
only"
[Link] = RGB(169, 169, 169) ' Gray
' Blue color for "entertainment" in Segment
Case LCase([Link]) Like "entertainment"
[Link] = RGB(0, 0, 255) ' Blue
' Purple color for "F & B" events in Segment
Case LCase([Link]) Like "f & b"
[Link] = RGB(128, 0, 128) ' Purple
' Red color for specific event categories in Segment
Case LCase([Link]) Like "spa" Or LCase([Link]) Like "shops" Or
_
LCase([Link]) Like "effy" Or LCase([Link]) Like "art
gallery" Or _
LCase([Link]) Like "watches"
[Link] = RGB(255, 0, 0) ' Red
End Select
Next cell
MsgBox "Event Data Processing Complete!", vbInformation
End Sub