Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
Dim iLad As Long
Dim sLad As String, sReason As String
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"
sLad = Range("H9").Value
sReason = Range("J9").Value
'only place I like GoTo's since IMHO is makes the flow easier to follow
If Len(sLad) = 0 Then GoTo NiceExit
If Len(sReason) = 0 Then GoTo NiceExit
With wsStats
'empty list, only headers so add as row 2
If .Cells(1, 1).CurrentRegion.Rows.Count = 1 Then
.Cells(2, 1).Value = DateSerial(Year(Now), Month(Now), Day(Now))
.Cells(2, 2).Value = sLad
.Cells(2, 3).Value = sReason
.Cells(2, 4).Value = 1
GoTo AllDone
End If
'first one of the day, any Lad so add at bottom
iLad = .Cells(1, 1).CurrentRegion.Rows.Count
If CLng(.Cells(iLad, 1).Value) < CLng(DateSerial(Year(Now), Month(Now), Day(Now))) Then
.Cells(iLad + 1, 1).Value = DateSerial(Year(Now), Month(Now), Day(Now))
.Cells(iLad + 1, 2).Value = sLad
.Cells(iLad + 1, 3).Value = sReason
.Cells(iLad + 1, 4).Value = 1
GoTo AllDone
End If
'start at bottom go up looking for Lad and Reason on Today
iLad = .Cells(1, 1).CurrentRegion.Rows.Count
Do While .Cells(iLad, 1).Value = DateSerial(Year(Now), Month(Now), Day(Now))
If .Cells(iLad, 2).Value = sLad And .Cells(iLad, 3).Value = sReason Then
.Cells(iLad, 4).Value = .Cells(iLad, 4).Value + 1
GoTo AllDone
Else
iLad = iLad - 1
If iLad = 1 Then Exit Do
End If
Loop
'if we got this far, we did not find matching Date, Lad and Reason so add at bottom
'yes, I know it'sthe same as 'first one of day, but I like the flow
iLad = .Cells(1, 1).CurrentRegion.Rows.Count
.Cells(iLad + 1, 1).Value = DateSerial(Year(Now), Month(Now), Day(Now))
.Cells(iLad + 1, 2).Value = sLad
.Cells(iLad + 1, 3).Value = sReason
.Cells(iLad + 1, 4).Value = 1
GoTo AllDone
End With
AllDone:
'clear Lad and Reson
Range("H9").Value = vbNullString
Range("J9").Value = vbNullString
NiceExit:
End Select
Application.EnableEvents = True
End Sub