Private Sub Worksheet_Change(ByVal Target As Range)
Dim lReply As Long
If Target.Cells.Count > 1 Then Exit Sub
If Target.Address = '$C$2'Then
If IsEmpty(Target) Then Exit Sub
If WorksheetFunction.CountIf(Range('trees'), Target) = 0 Then
lReply = MsgBox('Add entered name ' & _
Target & ' in the drop-down list?', vbYesNo + vbQuestion)
If lReply = vbYes Then
Range('trees').Cells(Range('trees').Rows.Count + 1, 1) = Target
End If
End If
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Target, Range('E2:E9')) Is Nothing And Target.Cells.Count = 1 Then
Application.EnableEvents = False
If Len(Target.Offset(0, 1)) = 0 Then
Target.Offset(0, 1) = Target
Else
Target.End(xlToRight).Offset(0, 1) = Target
End If
Target.ClearContents
Application.EnableEvents = True
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Target, Range('H2:K2')) Is Nothing And Target.Cells.Count = 1 Then
Application.EnableEvents = False
If Len(Target.Offset(1, 0)) = 0 Then
Target.Offset(1, 0) = Target
Else
Target.End(xlDown).Offset(1, 0) = Target
End If
Target.ClearContents
Application.EnableEvents = True
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Target, Range('C2:C5')) Is Nothing And Target.Cells.Count = 1 Then
Application.EnableEvents = False
newVal = Target
Application.Undo
oldval = Target
If Len(oldval) <> 0 And oldval <> newVal Then
Target = Target & ',' & newVal
Else
Target = newVal
End If
If Len(newVal) = 0 Then Target.ClearContents
Application.EnableEvents = True
End If
End Sub