How about something like this:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

Dim myRng As Range
Dim myCell As Range

Set myRng = Intersect(Target, Me.Range("a:a"))

If myRng Is Nothing Then Exit Sub

On Error GoTo errhandler:

Application.EnableEvents = False
For Each myCell In myRng.Cells
With myCell
If .Text = "" Then
Me.Cells(.Row, "B").Resize(1, 2).ClearContents
Else
.Offset(0, 1).Value = Application.UserName
With .Offset(0, 2)
.Value = Now
.NumberFormat = "MM/DD/YY hh:mm:ss AM/PM"
End With
End If
If Target.Cells.Count = 1 Then
Target.Offset(1, 0).Select
End If
End With
Next myCell

errhandler:
Application.EnableEvents = True

End Sub


"BVHis <" wrote:

I have a sheet that has some data validation set up so that you can't
enter the same thing twice withing a certain range. I did notice that
you can get around this by typing in what you want, select the cell,
then grab the lower-right corner of the highlighted selection and drag
which then creates multiple entries of the same thing. I want to avoid
that, but I can't seem to get something that looks "pleasing". What
I've managed to scrap together is shown in the code below. (I'm not
too fond of the UNDO part).

Here's the code that I have...

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim TargetParts() As String
Dim i As Integer

On Error GoTo ErrMsg
If Target.Value = "" Then
TargetParts() = Split(Target.Address, "$")
If Left(Target.Address, 2) = "$A" Then
Range("B" & TargetParts(2)).Select
ActiveCell.FormulaR1C1 = ""
Range("C" & TargetParts(2)).Select
ActiveCell.FormulaR1C1 = ""
Range("A" & TargetParts(2) + 1).Select
End If
End If

If Target.Value < "" Then
TargetParts() = Split(Target.Address, "$")
If Left(Target.Address, 2) = "$A" Then
Range("B" & TargetParts(2)).Select
ActiveCell.FormulaR1C1 = UCase$(Application.UserName)
Range("C" & TargetParts(2)).Select
ActiveCell.FormulaR1C1 = Format(Now, "MM/DD/YY hh:mm:ss
AMPM")
Range("A" & TargetParts(2) + 1).Select
End If
End If
Exit Sub

ErrMsg:
If Err.Number = "13" Then
Application.Undo
Exit Sub
End If
End Sub

Thanks in advance!

~ Matt W

---
Message posted from http://www.ExcelForum.com/

--

Dave Peterson