ExcelBanter - Create unique list from four lists

Assuming you want to sort alphabetical based on the first letter in each of
the cells, this is one option. It's probably more efficient to let Excel do
the sort rather than create the ADOR.Recordset but this should do the trick.

Steve Yandl

_________________________________________________

Sub GrabUniqueNames()

Const adVarChar = 200
Const MaxCharacters = 255

Dim strName As String
Dim nameArray()

Set objDic = CreateObject("Scripting.Dictionary")

For N = 11 To 19
strName = CStr(Cells(N, 4).Value)
If Not objDic.Exists(strName) Then
objDic.Add strName, strName
End If
strName = CStr(Cells(N, 12).Value)
If Not objDic.Exists(strName) Then
objDic.Add strName, strName
End If
Next N

For N = 26 To 34
strName = CStr(Cells(N, 4).Value)
If Not objDic.Exists(strName) Then
objDic.Add strName, strName
End If
strName = CStr(Cells(N, 12).Value)
If Not objDic.Exists(strName) Then
objDic.Add strName, strName
End If
Next N

If objDic.Count 0 Then
nameArray = objDic.Keys
End If

Set DataList = CreateObject("ADOR.Recordset")
DataList.Fields.Append "myNames", adVarChar, MaxCharacters
DataList.Open

For m = 0 To UBound(nameArray)
DataList.AddNew
DataList("myNames") = nameArray(m)
DataList.Update
Next m

DataList.Sort = "myNames"

R = 39
DataList.MoveFirst
Do Until DataList.EOF
Cells(R, 4).Value = DataList.Fields.Item("myNames")
R = R + 1
DataList.MoveNext
Loop

Set objDic = Nothing
Set DataList = Nothing
End Sub

_______________________________________________

"Bill_S" wrote in message
...
I need a macro that takes four lists of people on the spreadsheet and
creates
a single list of unique names, sorted alphabetically. The four ranges of
lists of people a D11:D19, L11:L19, D26:D34, L26:L34. I need to paste
the
unique list of names starting in cell D39. Thanks.