Prev: How to hibernate Windows XP at the end of macro?
Next: EXcel Chart Size Probelm with Printer - Please Help
From: burl_h on 22 Apr 2010 22:49
I'm using the following code to stop duplicate records being entered
into column A. In principle the macro works great but I would like to
add some enhancements.

First, on entry I'd like a message to say which cell has a duplicate
record, if one exists.
Secondly, I'd like the cell pointer (active cell) to goto the
duplicate record if one exists.

Any help would be greatly appreciated.

Thanks
burl_h

Private Sub Worksheet_Change(ByVal Target As Range)
Dim LastRow As Integer
If Target.Column = 1 Then
If Not IsEmpty(Target.Value) Then
LastRow = Cells(65536, Target.Column).End(xlUp).Row
For i = 1 To LastRow
If i <> Target.Row Then
If Cells(i, Target.Column).Value = Target.Value Then
MsgBox Target.Value & " already exists.", vbExclamation
Target.Value = Empty
Exit For
End If
End If
Next i
End If
End If
End Sub
From: Barb Reinhardt on 23 Apr 2010 02:02
Try this (with some additional notes)

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim LastRow As Long 'Integer
'Check out the highest value for integer vs
'the last row number in Excel 2007.

Dim myCell As Excel.Range
Dim i As Long
If Target.Column = 1 Then
'If Not IsEmpty(Target.Value) Then
If Not IsEmpty(Target.Value) Then
'LastRow = Cells(65536, Target.Column).End(xlUp).Row
LastRow = Me.Cells(Me.Rows.Count, Target.Column).End(xlUp).Row
For i = 1 To LastRow
If i <> Target.Row Then
Set myCell = Me.Cells(i, Target.Column)
'If myCell.Value = Target.Value Then 'Value is what's displayed
If myCell.Value2 = Target.Value2 Then
MsgBox Target.Value & " already exists in cell " & myCell.Address,
vbExclamation
'Target.Value = Empty
Application.EnableEvents = False
Target.ClearContents
myCell.Select
Application.EnableEvents = True

Exit For
End If
End If
Next i
End If
End If
End Sub

--
HTH,

Barb Reinhardt



"burl_h" wrote:

> I'm using the following code to stop duplicate records being entered
> into column A. In principle the macro works great but I would like to
> add some enhancements.
>
> First, on entry I'd like a message to say which cell has a duplicate
> record, if one exists.
> Secondly, I'd like the cell pointer (active cell) to goto the
> duplicate record if one exists.
>
> Any help would be greatly appreciated.
>
> Thanks
> burl_h
>
> Private Sub Worksheet_Change(ByVal Target As Range)
> Dim LastRow As Integer
> If Target.Column = 1 Then
> If Not IsEmpty(Target.Value) Then
> LastRow = Cells(65536, Target.Column).End(xlUp).Row
> For i = 1 To LastRow
> If i <> Target.Row Then
> If Cells(i, Target.Column).Value = Target.Value Then
> MsgBox Target.Value & " already exists.", vbExclamation
> Target.Value = Empty
> Exit For
> End If
> End If
> Next i
> End If
> End If
> End Sub
> .
>
From: ozgrid.com on 23 Apr 2010 02:07
Try;

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rDupe As Range
If Target(1, 1).Column = 1 Then
If Not IsEmpty(Target(1, 1)) Then
On Error Resume Next
Set rDupe = Range("A:A"). _
Find(What:=Target(1, 1), _
LookAt:=xlWhole, MatchCase:=False)
If rDupe Is Nothing Then
On Error GoTo 0
Exit Sub
Else
MsgBox "'" & Target(1, 1) & "' already exists"
With Application
.EnableEvents = False
.Undo
.EnableEvents = True
.Goto rDupe
On Error GoTo 0
End With
End If
End If
End If
End Sub



--
Regards
Dave Hawley
www.ozgrid.com
"burl_h" <milliela(a)zoominternet.net> wrote in message
news:cf949585-ef7e-4df7-84ff-9b359a769098(a)t36g2000yqt.googlegroups.com...
> I'm using the following code to stop duplicate records being entered
> into column A. In principle the macro works great but I would like to
> add some enhancements.
>
> First, on entry I'd like a message to say which cell has a duplicate
> record, if one exists.
> Secondly, I'd like the cell pointer (active cell) to goto the
> duplicate record if one exists.
>
> Any help would be greatly appreciated.
>
> Thanks
> burl_h
>
> Private Sub Worksheet_Change(ByVal Target As Range)
> Dim LastRow As Integer
> If Target.Column = 1 Then
> If Not IsEmpty(Target.Value) Then
> LastRow = Cells(65536, Target.Column).End(xlUp).Row
> For i = 1 To LastRow
> If i <> Target.Row Then
> If Cells(i, Target.Column).Value = Target.Value Then
> MsgBox Target.Value & " already exists.", vbExclamation
> Target.Value = Empty
> Exit For
> End If
> End If
> Next i
> End If
> End If
> End Sub

From: burl_h on 24 Apr 2010 11:59
Barb/Ozgrid,

I tried both solutions, I found that Barb's worked fine. However the
ozgrid solution failed to work, it gave the message a duplicate
existed when one clearly didn't.

Regards
burl_h
 | 
Pages: 1
Prev: How to hibernate Windows XP at the end of macro?
Next: EXcel Chart Size Probelm with Printer - Please Help