Scribd
Upload
3 views

final code

This VBA macro processes event data in an Excel worksheet by inserting new columns for 'Segment', 'Start Time', and 'End Time', and transferring data from existing columns. It formats the time values to include a space before 'AM' or 'PM', deletes unnecessary columns, and applies color coding to rows based on event types. Finally, it displays a message box indicating the completion of the data processing.

Uploaded by

sumangali.ashram1975
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as TXT, PDF, TXT or read online on Scribd
3 views

final code

This VBA macro processes event data in an Excel worksheet by inserting new columns for 'Segment', 'Start Time', and 'End Time', and transferring data from existing columns. It formats the time values to include a space before 'AM' or 'PM', deletes unnecessary columns, and applies color coding to rows based on event types. Finally, it displays a message box indicating the completion of the data processing.

Uploaded by

sumangali.ashram1975
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as TXT, PDF, TXT or read online on Scribd
You are on page 1/ 2

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 = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

' Find original columns for Segment, Start Time, End Time
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)

' Insert new columns for Segment, Start Time, End Time at the beginning (shift
existing columns to the right)
ws.Columns("A:C").Insert Shift:=xlToRight

' Set headers for new columns


ws.Range("A1").Value = "Segment"
ws.Range("B1").Value = "Start Time"
ws.Range("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
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 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 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

' Format Start Time and End Time to add space between numbers and AM/PM
For Each cell In ws.Range("B2:B" & lastRow)
If InStr(cell.Value, "am") > 0 Then
cell.Value = Replace(cell.Value, "am", " AM")
ElseIf InStr(cell.Value, "pm") > 0 Then
cell.Value = Replace(cell.Value, "pm", " PM")
End If
Next cell

For Each cell In ws.Range("C2:C" & lastRow)


If InStr(cell.Value, "am") > 0 Then
cell.Value = Replace(cell.Value, "am", " AM")
ElseIf InStr(cell.Value, "pm") > 0 Then
cell.Value = Replace(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

' Apply formatting based on criteria


For Each cell In ws.Range("A2:A" & lastRow)
Select Case True
' Gray color for "hidden" and "crew only" events
Case LCase(cell.Value) Like "hidden", LCase(cell.Value) Like "crew
only"
cell.EntireRow.Interior.Color = RGB(169, 169, 169) ' Gray

' Blue color for "entertainment"


Case LCase(cell.Value) Like "entertainment"
cell.EntireRow.Interior.Color = RGB(0, 0, 255) ' Blue

' Purple color for "F & B" events


Case LCase(cell.Value) Like "f & b"
cell.EntireRow.Interior.Color = RGB(128, 0, 128) ' Purple

' Red color for specific event categories


Case LCase(cell.Value) Like "spa" Or LCase(cell.Value) Like "shops" Or
_
LCase(cell.Value) Like "effy" Or LCase(cell.Value) Like "art
gallery" Or _
LCase(cell.Value) Like "watches"
cell.EntireRow.Interior.Color = RGB(255, 0, 0) ' Red
End Select
Next cell

MsgBox "Event Data Processing Complete!", vbInformation


End Sub

You might also like