PDA

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



drewloveland
12-08-2008, 05:13 PM
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

Kenneth Hobs
12-08-2008, 08:20 PM
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.
'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

drewloveland
12-12-2008, 01:31 PM
Ken, thanks so much, that's exactly what I needed.

GTO
12-12-2008, 03:42 PM
Greetings drewloveland,

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

Have a great day,

Mark