I think the following code will get you what you need. Just rerun it whenever you want to refresh the cell comments.
Sub ShowBookedBy()
Dim CurRw As Long, RoomRw As Long, TimeCol As Long
Application.ScreenUpdating = False
Range("J9:AH61").ClearComments
For CurRw = 9 To Range("A" & Rows.Count).End(xlUp).Row ' Loop through each booking
Select Case Cells(CurRw, 2).Value ' Find the calenda
Case "Mon": RoomRw = 9
Case "Tue": RoomRw = 18
Case "Wed": RoomRw = 27
Case "Thu": RoomRw = 36
Case "Fri": RoomRw = 45
Case "Sat": RoomRw = 54
Case Else: RoomRw = 0
End Select
If RoomRw > 0 Then ' Find the room within that day
Do Until Cells(RoomRw, 8).Value = Cells(CurRw, 5).Value
RoomRw = RoomRw + 1
If Cells(RoomRw, 8).Value = "" Then
MsgBox Cells(RoomRw, 8).Value & " not found for " & Cells(CurRw, 2).Value
Exit Sub
End If
Loop
TimeCol = 10
Do Until Format(Cells(8, TimeCol).Value, "hhmm") > Format(Cells(CurRw, 4).Value, "hhmm") Or TimeCol > 34
If Format(Cells(8, TimeCol).Value, "hhmm") >= Format(Cells(CurRw, 3).Value, "hhmm") Then
Cells(RoomRw, TimeCol).AddComment ' Flag the booked time slot
With Cells(RoomRw, TimeCol).Comment
.Text Text:="Booked by " & Cells(CurRw, 1).Value
.Visible = True
.Shape.Select
Selection.Height = 25
Selection.Width = 55
.Visible = False
End With
End If
TimeCol = TimeCol + 1
Loop
Else
MsgBox "Invalid day of week: " & Cells(CurRw, 2).Value
End If
Next
End Sub
Bookmarks