Worksheet_Change Event - Duplication Check, Ignore Blanks - excel

Question

I am using a VBA change event to look for duplicates in column C. The code below works but when i delete all values within the range, blanks are triggered as duplicates so i need to include a way to ignore duplicates from the code. Any ideas?
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
On Error GoTo ws_exit
Application.EnableEvents = False
With Target
If .Column = 3 Then
With .EntireColumn
Set cell = .Find(What:=Target.Value, AFter:=.Cells(1, 1))
If cell.Address = Target.Address Then
Set cell = .FindNext()
End If
If Not cell.Address = Target.Address Then
MsgBox "This Wall Reference already exists. Please ensure you have a unique reference identifier less than 20 characters in length", vbOKOnly
End If
End With
End If
End With
ws_exit:
Application.EnableEvents = True
End Sub
I expect to be able to ignore blanks but sill have the VBA run a duplication check to return a msgbox only if a duplication is found.

Answer 1

First you must consider that Target is a range of multiple cells and not only one cell. Therefore it is necessary to use Intersect to get all the cell that are changed in column 3 and then you need to loop through these cells to check each of them.
Also I recommend to use WorksheetFunction.CountIf to count how often this value occurs if it is >1 then it is a duplicate. This should be faster then using Find.
Note that the following code looks for duplicates in column 3 only if you want to check if a duplicate exists anywhere in the worksheet replace CountIf(Me.Columns(3), Cell.Value) with CountIf(Me.Cells, Cell.Value)
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim AffectedRange As Range
Set AffectedRange = Intersect(Target, Me.Columns(3))
If Not AffectedRange Is Nothing Then
Dim Cell As Range
For Each Cell In AffectedRange
If Application.WorksheetFunction.CountIf(Me.Columns(3), Cell.Value) > 1 Then
MsgBox "This Wall Reference already exists. Please ensure you have a unique reference identifier less than 20 characters in length", vbOKOnly + vbExclamation
End If
Next Cell
End If
End Sub
Instead of using VBA you could also use Conditional Formatting to highlight duplicates in red for example. Could be easier to archieve (use the =CountIf formula as condition). And also it will always highlight all duplicates immediately which makes it easy to determine them.

Answer 2

Thanks for the help K.Davis. I appreciate your time and effort.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Value = vbNullString Then Exit Sub
Dim cell As Range
On Error GoTo ws_exit
Application.EnableEvents = False
With Target
If .Column = 3 Then
With .EntireColumn
Set cell = .Find(What:=Target.Value, AFter:=.Cells(1, 1))
If cell.Address = Target.Address Then
Set cell = .FindNext()
End If
If Not cell.Address = Target.Address Then
MsgBox "This Glazing Reference already exists. Please ensure you have a unique reference identifier less than 20 characters in length", vbOKOnly
End If
End With
End If
End With
ws_exit:
Application.EnableEvents = True
End Sub