Vba code avoid duplivate

Vba code to avoid writing data in table
a    b    c   d
1    1   2    5 (highlited)
1   1    1     1
1   0    2     7(highlited)

The column A&C is the important . So the data in a+c should not repeat and must highlited or msgbox writen ( data entry are already exist)

Sheet name is ("data") range is (A1:F10000)
Nassim amAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
Place the code given below on Data Sheet Module.
To do so, follow these steps...
Right click on Data Tab --> View Code and paste the code given below into the opened code window.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
Dim x, dict
Dim i As Long, lr As Long, r As Long
If Target.Column = 1 Or Target.Column = 3 And Target.Row > 1 Then
    r = Target.Row
    lr = Cells(Rows.Count, "C").End(xlUp).Row
    If lr < 2 Then Exit Sub
    x = Range("A2:C" & lr).Value
    Set dict = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(x, 1)
        If i <> r - 1 Then
            dict.Item(x(i, 1) & x(i, 3)) = ""
        End If
    Next i
    If dict.exists(Cells(r, 1) & Cells(r, 3)) Then
        Range("A" & Target.Row).Interior.Color = vbRed
        Range("C" & Target.Row).Interior.Color = vbRed
    Else
        Range("A" & Target.Row).Interior.ColorIndex = xlNone
        Range("C" & Target.Row).Interior.ColorIndex = xlNone
    End If
End If
End Sub

Open in new window

0
Roy CoxGroup Finance ManagerCommented:
You can prevent duplicates using Data Validation, this way no problems will occur if a user does not enable macros

  • Select the range of cells in which you want to prevent duplicate values.
  • Choose Validation from the Data menu. Click the Data tab and choose Data Validation from the Data Validation option's drop-down list (in the Data Tools Group).
  • Click the Settings tab.
  • Choose Custom from the Allow drop-down list.
  • Enter a formula in the following form into the Formula control:=COUNTIF(COUNTIF($A$1:$A$50,A1)=1)
  • Click the Error Alert tab.
  • Enter "Caution:Duplicate Entry" in the Title control.
  • In the Error Message box, enter a meaningful description, such as £Duplicate entry detected"
  • Click OK

If a duplicate entry is made Excel will reject i. Click Cancel to clear the error message and enter a valid value.
0
Roy CoxGroup Finance ManagerCommented:
The formula above should be >1 not =1

Here's an alternative VBA approach

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    With Target
        If .CountLarge > 1 Then Exit Sub
        Dim rRng As Range

        Set rRng = Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))
        If Application.WorksheetFunction.CountIf(rRng, .Value) > 1 Then
            MsgBox "Duplicate entry"
            .Value = Empty
        End If
        
    End With
End Sub

Open in new window

0
Acronis True Image 2019 just released!

Create a reliable backup. Make sure you always have dependable copies of your data so you can restore your entire system or individual files.

Nassim amAuthor Commented:
Subodh Tiwari (Neeraj)
Thank you for answering me
But the code show nothing
I put it in module i writed duplicates wut nothing happened :(
0
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
Okay, please find the attache with the code on Data Sheet Module.
Try entering values and see if that works for you.
AvoidDuplicates.xlsm
1
Nassim amAuthor Commented:
Roy Cox

Thank for helping me
The code doesnt work
I upload it if you can show the problem

I do kot want to use conditional formatting because data is 20000 row with 5 lines .big data so it crush always
0
Nassim amAuthor Commented:
Subodh Tiwari (Neeraj)

That is all what is need may Allah bless you brother

Can i highlite to full row ( a:c ) not each one alone?
0
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
Thanks Nassim!

Replace the existing code with the following one...

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
Dim x, dict
Dim i As Long, lr As Long, r As Long
If Target.Column = 1 Or Target.Column = 3 And Target.Row > 1 Then
    r = Target.Row
    lr = Cells(Rows.Count, "C").End(xlUp).Row
    If lr < 2 Then Exit Sub
    x = Range("A2:C" & lr).Value
    Set dict = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(x, 1)
        If i <> r - 1 Then
            dict.Item(x(i, 1) & x(i, 3)) = ""
        End If
    Next i
    If dict.exists(Cells(r, 1) & Cells(r, 3)) Then
        Range("A" & r & ":C" & r).Interior.Color = vbRed
    Else
        Range("A" & r & ":C" & r).Interior.ColorIndex = xlNone
    End If
End If
End Sub

Open in new window

AvoidDuplicates-v2.xlsm
1
Nassim amAuthor Commented:
Subodh Tiwari (Neeraj)

The work but after highling the rows i delete or change the data to kot be duplicated
But it is highlited :/ even the row is empty
0
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
No. That should not be the case. If you remove the duplicates, the color will be gone. I tested it.
Can you upload a small sample file with the issue you are having?
1
Nassim amAuthor Commented:
For example it still red even i deleted duplicates row . Even i open in other ordinator
0
Nassim amAuthor Commented:
0
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
Which columns to be checked for duplicates? Column A is blank in the sample file while it is still being used in the code.
0
Nassim amAuthor Commented:
Ok brother i upload my final work with vba. I tried to edit it but it crushed again so i send it all

The red column (D) and (H) are the criteria
( I said A and C ) i tried to edit to d and h but is seems not working
. Sorry again
LAST-DUPLICATED.xlsm
0
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
This should be the code on Sheet Module as per your latest data layout.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
Dim x, dict
Dim i As Long, lr As Long, r As Long
If Target.Column = 4 Or Target.Column = 8 And Target.Row > 1 Then
    r = Target.Row
    lr = Cells(Rows.Count, "H").End(xlUp).Row
    If lr < 2 Then Exit Sub
    x = Range("D2:H" & lr).Value
    Set dict = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(x, 1)
        If i <> r - 1 Then
            dict.Item(x(i, 1) & x(i, 5)) = ""
        End If
    Next i
    If dict.exists(Cells(r, 4) & Cells(r, 8)) Then
        Range("D" & r & ":H" & r).Interior.Color = vbRed
    Else
        Range("D" & r & ":H" & r).Interior.ColorIndex = xlNone
    End If
End If
End Sub

Open in new window

LAST-DUPLICATED.xlsm
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Nassim amAuthor Commented:
Thank you brother :) it is done now .
It is really a good faver for me :D
0
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
You're welcome Nassim! Glad it worked as desired.
Please take a minute to close your question by accepting the answer.
1
Nassim amAuthor Commented:
Do not be laze to ask . Here you can find what you need . With expert teacher :D
1
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VBA

From novice to tech pro — start learning today.