Press button to assign the reason provided and count

[Paul_Hossler]

Some things to consider

The 'dual' lookup (PN and Desc) didn't really work. Changed formulas to always use PN, and Desc to use PN and PN to get Desc

I added a Lads absence feature based on my guesses

Made use of WB and WS events

Made the .Names dynamic so you can just add / delete

Rearranged some stuff and created some new .Names (sorry)

Option Explicit


Private Sub Workbook_Open()
    Init
End Sub

Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)
    Dim r As Range, rLad As Range
    Dim iLad As Long
    
    Set r = Target.Cells(1, 1)
    
    Application.EnableEvents = False
    Select Case r.Address
        Case "$D$8"
            Range("$D$9").Value = Application.Evaluate("=XLOOKUP(D8,PartNum,PartDesc,"""",0,1)")
        Case "$D$9"
            Range("$D$8").Value = Application.Evaluate("=XLOOKUP(D9,PartDesc,PartNum,"""",0,1)")
    
        Case "$H$9", "$J$9"
            If Len(Range("H9").Value) > 0 And Len(Range("J9").Value) > 0 Then
                iLad = Application.Evaluate("=XMATCH(H9,Lads,0,1)")
                Set rLad = [Lads].Cells(iLad, 1)
                Set rLad = rLad.Offset(0, 1)
                
                If CLng(rLad.Value) = CLng(Date) Then
                    Call MsgBox("Sorry, you only get one", vbCritical + vbOKOnly, "Taking Off")
                    Range("H9").Value = vbNullString
                    Range("J9").Value = vbNullString
                
                Else
                    rLad.Value = DateSerial(Year(Now), Month(Now), Day(Now))
                    Range("H9").Value = vbNullString
                    Range("J9").Value = vbNullString
                End If
            End If
    End Select
    Application.EnableEvents = True
End Sub

Option Explicit


Public wsStore As Worksheet, wsInput As Worksheet


Sub Init()

....
....
....