Results 1 to 9 of 9

Thread: Auto Unique List

  1. #1
    Junior Member
    Join Date
    Jun 2012
    Posts
    10
    Rep Power
    0

    Auto Unique List

    Dear All,

    I have a list in Sheet 1 in H column and I want unique list in Sheet 2, A column.

    But list calculates automatically are a conditions, as Sheet 2 are very hidden.

    Please advise.

    Means
    Sheet 1 visible!
    Sheet 2 very hidden!

    Required unique list in Sheet 2....

    Regards,

    RL

  2. #2
    Administrator Excel Fox's Avatar
    Join Date
    Mar 2011
    Posts
    1,402
    Rep Power
    10
    Does it start from first row? Does it have a header column?
    A dream is not something you see when you are asleep, but something you strive for when you are awake.

    It's usually a bad idea to say that something can't be done.

    The difference between dream and aim, is that one requires soundless sleep to see and the other requires sleepless efforts to achieve

    Join us at Facebook

  3. #3
    Administrator Excel Fox's Avatar
    Join Date
    Mar 2011
    Posts
    1,402
    Rep Power
    10
    Try something like this

    Code:
    Function GetUniqueList(rng As Range, ByRef lng As Long)
    
        Dim var As Variant
        Dim obj As Object
        
        Set obj = CreateObject("Scripting.Dictionary")
        If rng.Columns.Count = 1 Then
            var = rng
            For lng = LBound(var) To UBound(var)
                If Not obj.Exists(var(lng, 1)) Then
                    obj.Add var(lng, 1), var(lng, 1)
                End If
            Next lng
        End If
        lng = obj.Count
        GetUniqueList = Application.Transpose(obj.keys)
        
    End Function
    
    Sub Test()
        
        Dim lng As Long
        With Worksheets("Sheet2")
            .Range(.Cells(1), .Cells(.Rows.Count, 1).End(xlUp)).Value = Null
            .Cells(1).Resize(lng).Value = GetUniqueList(Worksheets("Sheet1").Range("H1:H" & Worksheets("Sheet1").Cells(Rows.Count, "H").End(xlUp).Row), lng)
        End With
        
    End Sub
    A dream is not something you see when you are asleep, but something you strive for when you are awake.

    It's usually a bad idea to say that something can't be done.

    The difference between dream and aim, is that one requires soundless sleep to see and the other requires sleepless efforts to achieve

    Join us at Facebook

  4. #4
    Administrator Admin's Avatar
    Join Date
    Mar 2011
    Posts
    1,123
    Rep Power
    10
    Hi

    or put this code in Sheet1 module. (Right click on Sheet1 tab name > view code > paste the code there)

    Code:
    Dim dic     As Object
    Private Sub Worksheet_Change(ByVal Target As Range)
        
        If Target.Column <> 8 Then Exit Sub
        
        Dim i   As Long
        Dim k
        
        
        If dic Is Nothing Then
            Set dic = CreateObject("scripting.dictionary")
                dic.comparemode = 1
        End If
        dic.RemoveAll
        If Not Intersect(Me.UsedRange, Me.Columns(8)) Is Nothing Then
            k = Intersect(Me.UsedRange, Me.Columns(8)).Value2
            If IsArray(k) Then
                For i = 1 To UBound(k, 1)
                    If Len(k(i, 1)) Then dic.Item(k(i, 1)) = Empty
                Next
                If dic.Count Then
                    With Sheet2
                        .Columns(1).Clear
                        .Cells(2, 1).Resize(dic.Count) = Application.Transpose(dic.keys)
                    End With
                End If
            ElseIf Len(k) Then
                Sheet2.Columns(1).Clear: Sheet2.Cells(2, 1) = k
            End If
        End If
                        
    End Sub
    Cheers !

    Excel Range to BBCode Table
    Use Social Networking Tools If You Like the Answers !

    Message to Cross Posters

    @ Home - Office 2010/2013/2016 on Win 10 (64 bit); @ Work - Office 2016 on Win 10 (64 bit)

  5. #5
    Junior Member
    Join Date
    Jun 2012
    Posts
    10
    Rep Power
    0
    Thanks I try Above!
    Wonderful!

    But in my original sheet having small changes, can you modified your above code.

    Sheet 1 Name:- WDO & Range starts from H6:H1201 for slection of Unique List.
    Sheet 2 Name:- MS amd A1 Cell having Cell Name RangeUnique; so I want unique list A2 to further below. Again Sheet 2, MS is very Hidden!

  6. #6
    Administrator Excel Fox's Avatar
    Join Date
    Mar 2011
    Posts
    1,402
    Rep Power
    10
    Crossposted here


    r_know, Cross-posting is like calling ten cab vendors at the same time, and hoping on the first one that comes along. There are clear rules about cross-posting. From a developers(volunteers) point-of-view, posting the same query across multiple forums is not appreciated, UNLESS you mention that in the respective forums explicitly, which will then allow volunteers to know whether a solution is already provided.

    We hope that you will comply to the said guidelines and not invite infractions.
    A dream is not something you see when you are asleep, but something you strive for when you are awake.

    It's usually a bad idea to say that something can't be done.

    The difference between dream and aim, is that one requires soundless sleep to see and the other requires sleepless efforts to achieve

    Join us at Facebook

  7. #7
    Junior Member
    Join Date
    Jun 2012
    Posts
    10
    Rep Power
    0
    True , I will keep in mind and will follow the forum rules in future. Actually, I did not get the answer which I am looking for, therefore posted here. Anyway, I accept and apology to forum and will not do again.

    But is it possible me a get answer to above, reason this code work great and I have required the modifications.

  8. #8
    Moderator
    Join Date
    Jul 2012
    Posts
    156
    Rep Power
    13
    The answer was already given to you a few posts ago.
    You could have figured out the minor changes to the code yourself, they weren't that difficult.
    This works fine for me.
    Code:
    Private Sub Worksheet_Change(ByVal Target As Range)
        Dim i As Long, dic As Object, k
        
        If Target.Column <> 8 Then Exit Sub
        
        If dic Is Nothing Then
            Set dic = CreateObject("scripting.dictionary")
                dic.comparemode = 1
        End If
        
        dic.RemoveAll
      
        If Not Intersect(Me.UsedRange, Me.Range("H6:H1201")) Is Nothing Then
            k = Intersect(Me.UsedRange, Me.Range("H6:H1201")).Value2
            If IsArray(k) Then
                For i = 1 To UBound(k, 1)
                    If Len(k(i, 1)) Then dic.Item(k(i, 1)) = Empty
                Next
                If dic.Count Then
                    With Sheets("MS")
                        .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp)).Clear
                        .Cells(2, 1).Resize(dic.Count) = Application.Transpose(dic.keys)
                    End With
                End If
            ElseIf Len(k) Then
                With Sheets("MS")
                    .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp)).Clear
                    .Cells(2, 1) = k
                End With
            End If
        End If
    End Sub

  9. #9
    Junior Member
    Join Date
    Jun 2012
    Posts
    10
    Rep Power
    0
    Thanks A Lot

    I was away for business trip and just back.

    I checked and worked perfect.

Similar Threads

  1. Numbered List Of Unique Values
    By xander1981 in forum Excel Help
    Replies: 6
    Last Post: 01-21-2013, 06:10 PM
  2. Extract Unique Values List
    By Rajan_Verma in forum Rajan Verma's Corner
    Replies: 4
    Last Post: 03-06-2012, 09:51 PM
  3. List Unique Values Using Formula
    By LalitPandey87 in forum Excel Help
    Replies: 5
    Last Post: 01-09-2012, 08:39 PM
  4. Replies: 2
    Last Post: 01-07-2012, 12:11 AM
  5. List Unique/Common Values From Two Ranges
    By Admin in forum Excel and VBA Tips and Tricks
    Replies: 0
    Last Post: 09-16-2011, 08:34 AM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •