Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1
Default Is there a better way to do this??

I have a sheet that has some data validation set up so that you can'
enter the same thing twice withing a certain range. I did notice tha
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 dra
which then creates multiple entries of the same thing. I want to avoi
that, but I can't seem to get something that looks "pleasing". Wha
I've managed to scrap together is shown in the code below. (I'm no
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:s
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

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

  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 2,824
Default Is there a better way to do this??

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

  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1
Default Is there a better way to do this??

Maybe it would help if I posted the file for you to better understan
what's going on.

Check out the Reservations tab.
Enter the number 1 in the SK # column.
Try to enter another 1 in the SK # column. See the message that pop
up? That's where I'm using the data validation. There should only b
one of any number in that column.
Now select the cell where you entered that number.
Grab the lower-right corner (the + symbol) and drag down. See how i
creates multiple 1's?? That's what I don't want the user to be able t
do, so in my code I'm using the UNDO function which makes Excel flas
like a strobe light.

Is there a way around that??


Thanks in advance!

~ Matt

Attachment filename: 0004000 - sample class project-revision log.zi
Download attachment: http://www.excelforum.com/attachment.php?postid=55980
--
Message posted from http://www.ExcelForum.com

  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 2,824
Default Is there a better way to do this??

I don't open attachments, but maybe...

application.screenupdating = false
'your undo code
application.screenupdating = true

Another option is to use a helper cell and put an error message in that cell.
It won't be exactly the same, but it might be enough to tell the user to fix the
data.

This has some trouble, but you may pick up an idea or two.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

Dim myRng As Range
Dim myRngToCheck As Range
Dim myCell As Range
Dim ErrorCtr As Long

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

If myRng Is Nothing Then Exit Sub

On Error GoTo errhandler:
ErrorCtr = 0
Application.EnableEvents = False
For Each myCell In myRng.Cells
With myCell
If .Text = "" Then
Me.Cells(.Row, "B").Resize(1, 2).ClearContents
Else
If Application.CountIf(myRngToCheck, .Value) 1 Then
'at least one already existed
.Resize(1, 3).ClearContents
ErrorCtr = ErrorCtr + 1
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
End If
End With
Next myCell

If ErrorCtr 0 Then
MsgBox "An error occurred with your last changed." & vbLf _
& "Please check: " & myRng.Address(0, 0)
Else
If Target.Cells.Count = 1 Then
Target.Offset(1, 0).Select
End If
End If

errhandler:
Application.EnableEvents = True

End Sub


"BVHis <" wrote:

Maybe it would help if I posted the file for you to better understand
what's going on.

Check out the Reservations tab.
Enter the number 1 in the SK # column.
Try to enter another 1 in the SK # column. See the message that pops
up? That's where I'm using the data validation. There should only be
one of any number in that column.
Now select the cell where you entered that number.
Grab the lower-right corner (the + symbol) and drag down. See how it
creates multiple 1's?? That's what I don't want the user to be able to
do, so in my code I'm using the UNDO function which makes Excel flash
like a strobe light.

Is there a way around that??

Thanks in advance!

~ Matt W

Attachment filename: 0004000 - sample class project-revision log.zip
Download attachment: http://www.excelforum.com/attachment.php?postid=559801
---
Message posted from http://www.ExcelForum.com/


--

Dave Peterson

Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On



All times are GMT +1. The time now is 09:02 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"