Selected Answer
Xxtran
I didn't notice your note in the file so this Answer may not be right but take a look any way please...
In the attached revised file, I assumed that the Booking Name pays $5 (but I think it should be Player though I didn't see an example). It needs to be opened with macros-enabled (please search the internet to see how with your version of Excel).
In the sheet "Oct", create a court booking (say row 217) but leave column F (Booking Name) to the last. Then choose a Booking name from the drop-down (e.g in F217). Once you do that this macro will run (commented for your understanding):
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cl As Range, Lieu As String, LDate As String
Dim BkText As String, r As VbMsgBoxResult, LstRw As Long, n As Long
' do nothing unless acell in F is changed
If Intersect(Target, Columns(6)) Is Nothing Then Exit Sub
' for any cells chnaged in F (e.g. via paste), loop though...
For Each Cl In Intersect(Target, Columns(6)).Cells
' skip if the timeslot in A is blank
If Cl.Value <> "" Then
' otherise, record the start time
LSession = Format(CDate(Cells(Target.Row, 1).Value), "hh:mm")
' got up the sheet from there but in column A
For n = Cl.Row To 2 Step -1
' if the cell is read, record the value as the game start time
If Cells(n, 1).Font.Color = 255 Then
LDate = Format(Cells(n, 1).Value, "yyyy-mm-dd")
' and jump out of loop to save venue (from line below, last time)
Exit For
End If
' if i's not a time, record it as the venue
If IsNumeric(Cells(n, 1).Value) = False Then Lieu = Cells(n, 1).Value
Next n
' collect the booking details, as recorded
BkText = Now & " " & Cl.Value & " booked " & Lieu & " " & LSession & " on " & LDate
' show details and tell the user to confirm or not
r = MsgBox(BkText, vbYesNo, "Proceed with this booking?")
If r = vbYes Then
' if yes, find last used row in Booking Fees...
LstRw = Worksheets("Booking Fees").Range("A" & Rows.Count).End(xlUp).Row
For n = 2 To LstRw
' loop down to match name
If Worksheets("Booking Fees").Cells(n, 1) = Cl.Value Then
' if found, increase column F by 1 (causes $5 charge) then exit loop
Worksheets("Booking Fees").Cells(n, 6) = Worksheets("Booking Fees").Cells(n, 6) + 1
Exit For
End If
Next n
' if name was found...
If n <= LstRw Then
' add bboking data after last row on that sheet
LstRw = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
Sheet1.Range("A" & LstRw + 1) = BkText
Else
' if not, tell user (and don't chnage sheets ### NEED to undo
MsgBox "Error- booking name " & Cl.Value & " not found. Either add name to Booking Fees sheet and try again OR undo changes"
End If
End If
End If
' loop back for next (if any)
Next Cl
End Sub
It will show a VBA Message Box with a summary showing current time and the booking e.g. "24/10/2023 09:17:07 Jingxin booked McClerry 12:15 on 2023-10-01". If you click "Yes", it will add 1 to column F (Playing frequency) on sheet "Booking Fees" so Jingxin is charged $5. It also records that booking on the last row of new sheet "Booking records" (so you can justify why a player owes an amount, should they question it).
Click "No" instead and that doesn't happen (but I didn't create an Undo)
If you change the same booking to another Booking Name, another fee is charged.
If you paste several entries for Booking Name (perhaps unlikely), it shows each one as detailed above.
Hope this gives you an insight into the power of VBA. Please comment and if I get time I'll correct the file.
