CODEWITHSUNDEEP
vbaexcel
Raaj Chauhan
Raaj Chauhan

Reputation: 13

Preventing duplicate entries in multiple columns

I am currently using this macro to prevent users from entering similar entries within a spreadsheet. This is working fine in a single column.

But how can I add similar in multiple columns (like Column A, D and F). Each column as to allow only unique records only. Please help me out

Private Sub Worksheet_Change(ByVal Target As Range)
    With Target
        If .Column <> 1 Or .Cells.Count > 1 Then Exit Sub
        If WorksheetFunction.CountIf(Columns(.Column), .Value) > 1 Then
            Application.DisplayAlerts = False
            .ClearContents
            Application.DisplayAlerts = True
            MsgBox "Record no. already exists!"
        End If
    End With
End Sub

Upvotes: 0

Views: 1690

Answers (2)

MarcinSzaleniec
MarcinSzaleniec

Reputation: 2256

I have modified your code within if and put in separate procedure in normal module:

Sub ClearCont(cl As Range)
    Application.EnableEvents = False
    cl.ClearContents
    Application.EnableEvents = True
    MsgBox "Record no. already exists!"
    'cl.Select
End Sub

Then, the code under worksheet should be like that:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range
    Dim col As Range

    With Target.Parent
        Set rng = Union(.Columns(1), .Columns(4), .Columns(6))
    End With


    With Target
        For Each col In rng.Columns
            If WorksheetFunction.CountIf(col, .Value) > 0 And col.Column <> .Column Then
                ClearCont Target
            ElseIf WorksheetFunction.CountIf(col, .Value) > 1 Then
                ClearCont Target
            End If
        Next col
    End With
End Sub

The expression 

Set rng = Union(.Columns(1), Columns(4), Columns(6))

chooses columns A, D and F, you can modify it to add more columns.

EDIT: As Peh below suggested, I have changed ActiveSheet to Target.Parent. I have also outcommented cl.Select in the ClearCont subroutine. I think this line of code would be useful if values are typed by hand directly in the worksheet - the user would be returned to the questioned cell. However, if values are entered by form for example, you would rather leave it out commented or delete it.

Upvotes: 0

Pᴇʜ
Pᴇʜ

Reputation: 57743

You can apply this code to an additional column just by changing your if statement in your original code and allow another column 

If (.Column <> 1 And .Column <> 4) Or .Cells.Count > 1 Then Exit Sub

more columns can be added with additional And statements And .Column <> xxx

If (.Column <> 1 And .Column <> 4 And .Column <> 6) Or .Cells.Count > 1 Then Exit Sub

Upvotes: 1

Related Questions