CODEWITHSUNDEEP
excelvba
Vikas Kumar
Vikas Kumar

Reputation: 97

Avoid pasting duplicate set of values in a column in excel

I am working on a basic thing but somehow not able to crack it.

I have to develop a simple macro using VB script in excel that can prevent users from pasting a set values in which duplicates are there.

For example, Under column A of an excel, if someone tries to copy following:

    cat  
    mat  
    rat  
    cat

Error must be thrown with a msg:

"Trying to paste duplicate value"

I am able to right following code that reflect the duplicate message.

    Sub Highlight_Duplicates(Values As Range)
    Dim Cell

    For Each Cell In Values
      If WorksheetFunction.CountIf(Values, Cell.Value) > 1 Then
        MsgBox "Duplicate Value"
    End If

  Next Cell
 End Sub

Private Sub Auto_Load()

 Highlight_Duplicates (Sheets("Sheet1").Range("A1:A10"))

End Sub

But I am unable to restrict the user from pasting the set of values.

Kindly advise.

Upvotes: 0

Views: 1286

Answers (1)

JNevill
JNevill

Reputation: 50019

You can use the Worksheet_Change() event Application.Undo

In the worksheet's code page that you want to track this activity/event you can do something like:

Private Sub Worksheet_Change(ByVal Target As Range)
    'Test if it's the column we want. Test that only one thing was pasted.
    If Not Intersect(Target, Range("A:A")) Is Nothing And Target.Cells.Count = 1 Then
        'Test to see how many times this value is in use.
        'If greater than one, then undo the paste and yell at the user
        If Application.WorksheetFunction.CountIf(Range("A:A"), Target.Value) > 1 Then
            Application.Undo
            MsgBox ("The value " & Target.Value & " is already present")
        End If
    End If
End Sub

One way to tackle multiple pasted values would be: Private Sub Worksheet_Change(ByVal Target As Range) 'Test if it's the column we want. Test that only one thing was pasted. If Not Intersect(Target, Range("A:A")) Is Nothing Then

        'Loop through each cell in the target range (as multiple may have been pasted)
        Dim TargetCell as Range
        For each TargetCell in Target.Cells

            'Test to see how many times this value is in use.
            'If greater than one, then undo the paste and yell at the user
            If Application.WorksheetFunction.CountIf(Range("A:A"), TargetCell.Value) > 1 Then
                Application.Undo
                MsgBox ("The values pasted contained at least one duplicate. Duplicate found:" & TargetCell.Value)
                Exit For
            End If
        Next TargetCell
    End If
End Sub

These should serve as a good place to start and can be tweaked to do whatever you need to.

Upvotes: 1

Related Questions