How to extract unique value from Filter in excel vba macro

Hello folks,

 

Welcome back...today will teach you "how to get unique values from set of values in excel using macro coding"

Open your excel file and create some duplicate data … (Don’t wait open and create now)

 

Here is my  duplicate data…



Now don’t wait for me, open VBA and do coding … (I can’t explain again the vba part so just visit How to write VBA coding  if you have any doubts)

If you are in developer mode then insert new module to do coding.

Paste the below coding’s on module (If you are a good Developer then you should do Copy Paste)

Sub UniqueValue()

Dim d As Object, c As Variant, i As Long, lr As Long

Set d = CreateObject("Scripting.Dictionary")

lr = ThisWorkbook.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row

c = Range("A2:A" & lr)

For i = 1 To UBound(c, 1)

d(c(i, 1)) = 1

Next i

With ThisWorkbook.Worksheets(1)

.Activate

.Range("G1").Resize(d.Count) = Application.Transpose(d.Keys)

.Range("h1") = d.Count

End With

End Sub

Press F5 and Run

Gotcha! You got the final result

 

Now time to the coding part explanation …..If it is feel bore than I can’t do anything 

What is Sub? 
 
A Sub called procedure or a block of code, sub is executed in response to an event (Don’t ask what is Procedure? and what is Event? If you need explanation please comment)

Hint: Sub does not return any value.Sub UniqueValue()
End Sub



Variable Declaration:



Dim d As Object, c As Variant, i As Long, lr As Long

You can declare also like 

Dim d As Object
Dim c As variant 

Here I am going to set d object as a scripting dictionary ….Eeeeeeee don’t ask again what Script Dictionary ? check here my old post… (what is Script Dictionary?)



 d = CreateObject("Scripting.Dictionary") 

 Now, find last row of the particular column. (any one of these method)


lr = ThisWorkbook.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row

 lr = ThisWorkbook.Worksheets("Sheet1").Cells(ThisWorkbook.Worksheets("Sheet1").Rows.Count, "A").End(xlUp).Row

lr =ThisWorkbook.Worksheets("Sheet1").UsedRange.Rows(ThisWorkbook.Worksheets("Sheet1").UsedRange.Rows.Count).Row

lr = ThisWorkbook.Worksheets("Sheet1").Range("A1").CurrentRegion.Rows.Count

okay, now some tricks…

We have a variable C as a variant data type. I am going to assign range of duplicate values in C

c = Range("A2:A" & lr)

Now use the below loop to assign unique values in dictionary object d . If you understand Scripting Dictionary then you will understand this loop.

For i = 1 To UBound(c, 1)

  d(c(i, 1)) = 1

Next i

 Reassign the last row and paste the value using transpose method

.Range("G2").Resize(d.Count) = Application.Transpose(d.Keys)

 


If you think above program is totally waste and then go with this

 
Use this coding ............

Public Sub Test()

ActiveSheet.Range("A2:A65536").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ActiveSheet.Range("B2"), Unique:=True

End Sub

 

One line code will solve your problems. But it will work only in filter