Create Custom Function

Through this template user can retrieve unique records after eliminating the duplicates

Retrieve Unique records
Create Data validation for Unique records

Aforementioned two taks accomplished by creating CUSTOM FUNCTIONS using VBA Macros

click on below mentioned image to watch video:

Download The Workbook

Function UniqueData()

'Select the Data Range
Dim Rng As Range
Set Rng = Application.InputBox("Select The Range", Application.UserName, Type:=8)

'Declare variables
Dim r As Integer 'Loop Variable
Dim CRng As Range 'Count function Range
Dim Criteria
For r = Rng.Row To Rng.Row + Rng.Rows.Count - 1
Set CRng = Range(Cells(Rng.Row, Rng.Column), Cells(r, Rng.Column))
Criteria = Cells(r, Rng.Column).Value
If Application.WorksheetFunction.CountIf(CRng, Criteria) = 1 Then
UniqueData = UniqueData & "," & Criteria
End If
Next
UniqueData = Right(UniqueData, Len(UniqueData) - 1)
Application.Wait (Now + TimeValue("00:00:01"))
End Function

Function UniqueDataDropDown()
'Select the Data Range
Dim Rng As Range
Set Rng = Application.InputBox("Select The Range", Application.UserName, Type:=8)

'Declare variables
Dim r As Integer 'Loop Variable
Dim CRng As Range 'Count function Range
Dim Criteria
For r = Rng.Row To Rng.Row + Rng.Rows.Count - 1
Set CRng = Range(Cells(Rng.Row, Rng.Column), Cells(r, Rng.Column))
Criteria = Cells(r, Rng.Column).Value
If Application.WorksheetFunction.CountIf(CRng, Criteria) = 1 Then
UniqueDataDropDown = UniqueDataDropDown & "," & Criteria
End If
Next
UniqueDataDropDown = Right(UniqueDataDropDown, Len(UniqueDataDropDown) - 1)
Application.Wait (Now + TimeValue("00:00:01"))

End Function

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Selection.Rows.Count = ActiveSheet.Rows.Count Then
Exit Sub
End If
Application.EnableEvents = False

If ActiveCell.Offset(-1, 0).FormulaLocal = "=UniqueData()" Or ActiveCell.Offset(-1, 0).FormulaLocal = "=UniqueDataDropDown()" Then
Dim InputData
Dim PostSplit
Dim RowNumb As Integer
End If
'=========================================================
If ActiveCell.Offset(-1, 0).FormulaLocal = "=UniqueData()" Then

InputData = ActiveCell.Offset(-1, 0).Value

PostSplit = Split(InputData, ",")
RowNumb = ActiveCell.Offset(-1, 0).Row

For r = 0 To UBound(PostSplit)
Cells(r + RowNumb, ActiveCell.Column).Value = PostSplit(r)
Next
End If
'===================================================

If ActiveCell.Offset(-1, 0).FormulaLocal = "=UniqueDataDropDown()" Then
InputData = ActiveCell.Offset(-1, 0).Value
RowNumb = ActiveCell.Offset(-1, 0).Row

With ActiveCell.Offset(-1, 0).Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=InputData
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
End If

Application.EnableEvents = True

End Sub