Basic duplicate needed please

[ipbr21054]

Hi,

I am looking for a basic duplicate code so when i leave a specific cell the code would run.

So my new code should work like this.

Worksheet is called DATABASE
Cell where i would type the customers name is always A6
Once i leave cell A6 the code should check for a duplicate in only the Column range A6 & down the page.
If no duplicate is found then allow me to continue.
If a duplicate is found then show a msgbox yes / no asking would i like to be taken to that cell where the duplicate was found.
No just closes the msgbox where yes would take me to the cell where the duplicate is.

Thanks

 

[My Aswer Is This]

Try this:
This is an auto sheet event script
Your Workbook must be Macro enabled
To install this code:
Right-click on the sheet tab
Select View Code from the pop-up context menu
Paste the code in the VBA edit window

When you enter a value in Range("A6") the script will run

Private Sub Worksheet_Change(ByVal Target As Range)
'Modified  8/6/2019  11:46:11 AM  EDT
If Target.Address = Range("A6").Address Then
Dim lastrow As Long
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Dim SearchString As String
Dim SearchRange As Range
SearchString = Target.Value
Set SearchRange = Range("A7:A" & lastrow).Find(SearchString, LookIn:=xlValues, lookat:=xlWhole)
If SearchRange Is Nothing Then
Else
r = SearchRange.Row
ans = MsgBox("We found a duplicate. Do you want to be taken to that row", vbYesNo)
If ans = vbYes Then Application.Goto Range("A" & r)
End If
End If
End Sub

 

[ipbr21054]

Hi,
I allready have a Worksheet change code on my sheet already see below,

Private Sub Worksheet_Change(ByVal Target As Range)    With Target
        If .Column = 13 Then Exit Sub
        If .Count = 1 And Not .HasFormula Then
            Application.EnableEvents = False
            .Value = UCase(.Value)
            Application.EnableEvents = True
        End If
    End With
End Sub

So if ive merged the two correctly i then have this.

Private Sub Worksheet_Change(ByVal Target As Range)'Modified  8/6/2019  11:46:11 AM  EDT
If Target.Address = Range("A6").Address Then
Dim lastrow As Long
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Dim SearchString As String
Dim SearchRange As Range
SearchString = Target.Value
Set SearchRange = Range("A7:A" & lastrow).Find(SearchString, LookIn:=xlValues, lookat:=xlWhole)
If SearchRange Is Nothing Then
Else
r = SearchRange.Row
ans = MsgBox("We found a duplicate. Do you want to be taken to that row", vbYesNo)
If ans = vbYes Then Application.Goto Range("A" & r)
    With Target
        If .Column = 13 Then Exit Sub
        If .Count = 1 And Not .HasFormula Then
            Application.EnableEvents = False
            .Value = UCase(.Value)
            Application.EnableEvents = True
        End If
    End With
End If
End If
End Sub

But after typing in cell A6 and going to cell B6 i see this this message.
Variable not defined & this below in yellow.

r = SearchRange.Row

 

[My Aswer Is This]

What is your code attempting to do?

If .Column = 13 Then Exit Sub
​

 

[ipbr21054]

hi,

Just looking at the existing worksheet change im not sure as i dont see what its refering to.

 

[ipbr21054]

I just removed my code and just used your advised code but i still get variable not defined.

This part is in yellow.

r = SearchRange.Row

 

[ipbr21054]

Apart from changing to uppercase i dont understand what the code refers to =13 / =1 ???

we could run with your code & uppercase and as i use it would see something out of place i think

 

[My Aswer Is This]

Try this:

Private Sub Worksheet_Change(ByVal Target As Range)
'Modified  8/6/2019  1:32:22 PM  EDT
If Target.Address = Range("A6").Address Then
Dim lastrow As Long
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Dim SearchString As String
Dim SearchRange As Range
Dim r As Long
SearchString = Target.Value
Set SearchRange = Range("A7:A" & lastrow).Find(SearchString, LookIn:=xlValues, lookat:=xlWhole)
If SearchRange Is Nothing Then
Else
r = SearchRange.Row
ans = MsgBox("We found a duplcate. Do you want to be taken to that row", vbYesNo)
If ans = vbYes Then Application.Goto Range("A" & r)
End If
End If
End Sub

 

[ipbr21054]

Same error message but down a line now.

r = SearchRange.Row
[COLOR=#b22222]ans[/COLOR] = MsgBox("We found a duplcate. Do you want to be taken to that row", vbYesNo)
If ans = vbYes Then Application.Goto Range("A" & r)
End If
End If
End Sub

 

[My Aswer Is This]

Well it works for me but try this:

Private Sub Worksheet_Change(ByVal Target As Range)
'Modified  8/6/2019  1:50:22 PM  EDT
If Target.Address = Range("A6").Address Then
Dim lastrow As Long
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Dim SearchString As String
Dim SearchRange As Range
Dim r As Long
Dim ans As Variant
SearchString = Target.Value
Set SearchRange = Range("A7:A" & lastrow).Find(SearchString, LookIn:=xlValues, lookat:=xlWhole)
If SearchRange Is Nothing Then
Else
r = SearchRange.Row
ans = MsgBox("We found a duplcate. Do you want to be taken to that row", vbYesNo)
If ans = vbYes Then Application.Goto Range("A" & r)
End If
End If
End Sub