Consulting

Results 1 to 4 of 4

Thread: Solved: Make a list of unique names from columns on multiple sheets

  1. #1

    Solved: Make a list of unique names from columns on multiple sheets

    Hi,

    I need some help on a macro that will make a list of unique names on one worksheet from data on 3 other worksheets. I've attached a sensitive-information-removed version of my file to this post. Basically, I need to create a list of unique names on the "Individuals" tab under the "Developer / Engineer" column. The source data would be all persons listed under column D on the other 3 sheets: "Assigned," "Closed," and "Open." I figured out how to do this using the Advanced Filter, but I can only get it to work using the data from 1 sheet. I'm not sure how to automate this so it can grab the data from all 3 without overwriting anything. I can't just consolidate the 3 sheets as it would mess up my formulas on the summary "Individuals" tab. Any help would be appreciated.

    Thanks

  2. #2
    VBAX Guru Kenneth Hobs's Avatar
    Joined
    Nov 2005
    Location
    Tecumseh, OK
    Posts
    4,956
    Location
    Welcome to the forum!

    I don't have time to optimize this tonight. It took 8s to run on my slow notebook.

    If you don't want to import the speed Module from the kb, comment those 2 lines out.

    Also, it was unclear how you want to insert the results. You had a total at the end. One generally inserts the data at row 2 or the next empty row up from the bottom.
    [VBA]'Speed routines at: http://vbaexpress.com/kb/getarticle.php?kb_id=1035
    Sub DeleteDups()
    Dim v, z, c
    Dim toRange As Range, fromRange As Range
    Dim WSName() As Variant
    Dim d As Object

    SpeedOn
    On Error GoTo EndSub
    WSName() = [{"Assigned", "Closed", "Open"}]
    Set d = CreateObject("Scripting.Dictionary")
    d.comparemode = vbTextCompare
    Set toRange = Worksheets("Individuals").Range("A2")

    For Each z In WSName()
    Set fromRange = Worksheets(z).Range("D2", Worksheets(z).Range("D" & Rows.Count).End(xlUp))
    For Each v In fromRange
    If Not IsEmpty(v) And Not d.exists(v.Value) Then d.Add v.Value, Nothing
    Next v
    Next z
    z = d.keys
    'Overwrite A2 down.
    toRange.Resize(UBound(z) + 1).ClearContents
    toRange.Resize(UBound(z) + 1).Value = Application.Transpose(z)
    EndSub:
    Set d = Nothing
    SpeedOff
    End Sub
    [/VBA]

  3. #3
    Ken, thanks so much, that's exactly what I needed.

  4. #4
    Knowledge Base Approver VBAX Guru GTO's Avatar
    Joined
    Sep 2008
    Posts
    3,368
    Location
    Greetings drewloveland,

    If solved, you can mark Solved by using the Thread Tools button right above your first post.

    Have a great day,

    Mark

Posting Permissions

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