VBA to extract unique values from different sheets and different columns

[amandeep08]

Dear All,

I have one excel workbook with 3 different sheets. I want the unique values from these sheets but the problem is that the data is in different columns. How i can extract the Unique name in new sheet. Attached is the sample file

Book1
	D
8
Summary

Aman

 

[Legacy 143009]

There is no sample file

 

[Peter_SSs]

Attached is the sample file

You need to actually select the range that you want to show before clicking Mini sheet.

BTW, I suggest that you update your Account details (click your user name at the top right of the forum) so helpers always know what Excel version(s) & platform(s) you are using as the best solution often varies by version. (Don’t forget to scroll down & ‘Save’)

 

[amandeep08]

Dear All,

I have one excel workbook with 3 different sheets. I want the unique values from these sheets but the problem is that the data is in different columns. How i can extract the Unique name in new sheet. Attached is the sample file

Book1
	D
8
Summary

Aman

Sample File.xlsx
	A	B	C
1	Unique Name
2	ASD
3	SDF
4	DFG
5	FGH
6	ter
7	wert
8	hrrd
9	yyu
10	tyr
11
Summary

 

[Peter_SSs]

The above single mini sheet does show us anything about this ..

3 different sheets. I want the unique values from these sheets but the problem is that the data is in different columns.

(You also have not addressed the last paragraph of my previous post)

 

[Alex Blakenburg]

See if this is any use to you:-
(it assumes that each sheet has a column called "Name", change that if it is called something else)

Sub UniqueNames()

    Dim srcSht As Worksheet, sumSht As Worksheet
    Dim strHdg As String, rFindHdg As Range, srcRng As Range
    Dim dictSrc As Object, dictKey As String
    Dim srcArr As Variant
    Dim i As Long
    
    Set sumSht = Worksheets("Summary")              '<--- Change if required
    strHdg = "Name"                                 '<--- Change if required
    Set dictSrc = CreateObject("Scripting.dictionary")
    
    For Each srcSht In Worksheets(Array("Sheet1", "Sheet2", "Sheet3")) '<--- Change the names of the 3 sheets
        
        With srcSht
            Set rFindHdg = srcSht.UsedRange.Find(What:=strHdg, LookIn:=xlValues, _
                                 LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                                 MatchCase:=False, SearchFormat:=False)
            If rFindHdg Is Nothing Then Exit For
            
            srcArr = .Range(rFindHdg.Offset(1), .Cells(Rows.Count, rFindHdg.Column).End(xlUp))
        End With
        ' Load names column in each sheet into Dictionary
        For i = 1 To UBound(srcArr)
            dictKey = srcArr(i, 1)
            If Not dictSrc.exists(dictKey) Then
                dictSrc(dictKey) = i
            End If
        Next i
    Next srcSht
    
    With sumSht
        .Range("A1").CurrentRegion.Offset(1).ClearContents
        .Range("A1").Offset(1).Resize(dictSrc.Count) = Application.Transpose(dictSrc.Keys)
        .Range("A1").CurrentRegion.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlYes
    End With

End Sub

 

[amandeep08]

H

See if this is any use to you:-
(it assumes that each sheet has a column called "Name", change that if it is called something else)

Sub UniqueNames()

    Dim srcSht As Worksheet, sumSht As Worksheet
    Dim strHdg As String, rFindHdg As Range, srcRng As Range
    Dim dictSrc As Object, dictKey As String
    Dim srcArr As Variant
    Dim i As Long
   
    Set sumSht = Worksheets("Summary")              '<--- Change if required
    strHdg = "Name"                                 '<--- Change if required
    Set dictSrc = CreateObject("Scripting.dictionary")
   
    For Each srcSht In Worksheets(Array("Sheet1", "Sheet2", "Sheet3")) '<--- Change the names of the 3 sheets
       
        With srcSht
            Set rFindHdg = srcSht.UsedRange.Find(What:=strHdg, LookIn:=xlValues, _
                                 LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                                 MatchCase:=False, SearchFormat:=False)
            If rFindHdg Is Nothing Then Exit For
           
            srcArr = .Range(rFindHdg.Offset(1), .Cells(Rows.Count, rFindHdg.Column).End(xlUp))
        End With
        ' Load names column in each sheet into Dictionary
        For i = 1 To UBound(srcArr)
            dictKey = srcArr(i, 1)
            If Not dictSrc.exists(dictKey) Then
                dictSrc(dictKey) = i
            End If
        Next i
    Next srcSht
   
    With sumSht
        .Range("A1").CurrentRegion.Offset(1).ClearContents
        .Range("A1").Offset(1).Resize(dictSrc.Count) = Application.Transpose(dictSrc.Keys)
        .Range("A1").CurrentRegion.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlYes
    End With

End Sub

Hi Alex,

Thanks a lot for the Coding.

It is providing the results as per expectation.

I will thoroughly check the same.

Aman