Show Warning If Duplicate Value Entered In Column Cells (2 Easy Way)

Download! Warn_for_duplicate_values.XLSM

Form Sources Code

				
					'For more: https://msexcelvba.com

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Dim Lng As Long, Final, STR As String
    Dim Rng As Range
    
    If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
    
    Lng = Cells(Rows.Count, "A").End(xlUp).Row
   On Error Resume Next
    If WorksheetFunction.CountIf(Range("A2:A" & Lng), Target) < 1 Then
    Exit Sub
    End If
    If WorksheetFunction.CountIf(Range("A2:A" & Lng), Target) > 1 Then
        
    STR = Empty
    Set Rng = Range("A2:A" & Lng).Find(Target, , xlValues, xlWhole)
    If Not Rng Is Nothing Then
     adres = Rng.Address
       Do
     STR = STR & Rng.Row & "      -      " & Cells(Rng.Row, "A") & Chr(10)
    Set Rng = Range("A2:A" & Lng).FindNext(Rng)
    Loop While Not Rng Is Nothing And Rng.Address <> adres
    End If
    Final = MsgBox("Row No:        Records :" & vbCrLf & Chr(10) & STR & vbLf & "Do you want to enter Dupplicated?", vbYesNo, "")
    If Final = vbYes Then MsgBox "Recording has been completed.", vbInformation, "Info"
    If Final = vbNo Then Target.ClearContents
    End If
End Sub

Code Explanation

				
					    
    Dim Lng As Long, Final, STR As String
    Dim Rng As Range

Defined variable

				
					 If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub

Set Target Range Entire Column

				
					    Lng = Cells(Rows.Count, "A").End(xlUp).Row

Set The Last Row

				
					On Error Resume Next

Skip Error Go To next

				
					 If WorksheetFunction.CountIf(Range("A2:A" & Lng), Target) < 1 Then
    Exit Sub
    End If

IF condition Count Less Then 1

				
					If WorksheetFunction.CountIf(Range("A2:A" & Lng), Target) > 1 Then
STR = Empty

IF condition Count Greater Then 1 , STR variable Empty

				
					Set Rng = Range("A2:A" & Lng).Find(Target, , xlValues, xlWhole)
    If Not Rng Is Nothing Then
     adres = Rng.Address
       Do

Find Value In Whole Range , If Nothing adres = range address

				
					   STR = STR & Rng.Row & "      -      " & Cells(Rng.Row, "A") & Chr(10)
    Set Rng = Range("A2:A" & Lng).FindNext(Rng)
    Loop While Not Rng Is Nothing And Rng.Address <> adres
    End If

Loop

				
					 Final = MsgBox("Row No:        Records :" & vbCrLf & Chr(10) & STR & vbLf & "Do you want to enter Dupplicated?", vbYesNo, "")

Msgbox VBA Yes No Prompt

				
					If Final = vbYes Then MsgBox "Recording has been completed.", vbInformation, "Info"
    If Final = vbNo Then Target.ClearContents
    End If

If VBA Box Yes Then run First Line else cell clear.

the second solution, we used Excel COUNT IF formula to warn for duplicate value entering.

First of all, on the Warm sheet, we selected column C.
We have selected Custom item in Allow section of Data Validation Settings tab from “Data” top menu. In the Formula section, we entered this formula:

=COUNTIF(C:C,C7)=1