This is very similar to a request I did on Sunday. I modified the code
from Sunday below. Here is the link to Sundays request
http://tinyurl.com/33sz3mj
Sub LookupNames()
'put names into column IV
'then use advancefilter to put names at bottom
'of worksheet
'use data in column A to get Last Row
LastRow = Range("A" & Rows.Count).End(xlUp).Row
'put final list 5 rows down from last date
NewRow = LastRow + 5
'put header in IV1 so advance filter doesn't create duplicate entry
Range("IV1") = "Unique Names"
'copy first set of names in column B to column IV
Range("A1:A" & LastRow).Copy _
Destination:=Range("IV2")
'get last row of new data
LastRowNewData = Range("IV" & Rows.Count).End(xlUp).Row
'Copy Second List of names in column D to column IV
Range("C1:C" & LastRow).Copy _
Destination:=Range("IV" & (LastRowNewData + 1))
'get last row of new data
LastRowNewData = Range("IV" & Rows.Count).End(xlUp).Row
'Copy third List of names in column F to column IV
Range("E1:E" & LastRow).Copy _
Destination:=Range("IV" & (LastRowNewData + 1))
'get last row of new data
LastRowNewData = Range("IV" & Rows.Count).End(xlUp).Row
Range("G1:G" & LastRow).Copy _
Destination:=Range("IV" & (LastRowNewData + 1))
'get last row of new data
LastRowNewData = Range("IV" & Rows.Count).End(xlUp).Row
'use Advance filter to move copy data
'put Data 1 starting one row below NewRow
Range("IV1:IV" & LastRowNewData).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Range("A" & (NewRow - 1)), _
Unique:=True
'delete temporary data in column IV
Columns("IV").Delete
LastRowUnique = Range("A" & Rows.Count).End(xlUp).Row
'Unique names goes from NewRow to LastRowUnique
'=IF(ISERROR(VLOOKUP(A10,A$1:A$4,2,False)),"",VLOO KUP(A10,A$1:A$4,2,False))
'=IF(ISERROR(VLOOKUP(A10,C$1:C$4,2,False)),"",VLOO KUP(A10,C$1:C$4,2,False))
'=IF(ISERROR(VLOOKUP(A10,E$1:E$4,2,False)),"",VLOO KUP(A10,E$1:E$4,2,False))
'=IF(ISERROR(VLOOKUP(A10,G$1:G$4,2,False)),"",VLOO KUP(A10,G$1:G$4,2,False))
Lookup1Str = "VLookup(A" & NewRow & ",A$1:B$" & LastRow & ",2,False)"
Lookup2Str = "VLookup(A" & NewRow & ",C$1:D$" & LastRow & ",2,False)"
Lookup3Str = "VLookup(A" & NewRow & ",E$1:F$" & LastRow & ",2,False)"
Lookup4Str = "VLookup(A" & NewRow & ",G$1:H$" & LastRow & ",2,False)"
Range("B" & NewRow).Formula = _
"=IF(ISERROR(" & Lookup1Str & "),""""," & Lookup1Str & ")"
Range("C" & NewRow).Formula = _
"=IF(ISERROR(" & Lookup2Str & "),""""," & Lookup2Str & ")"
Range("D" & NewRow).Formula = _
"=IF(ISERROR(" & Lookup3Str & "),""""," & Lookup3Str & ")"
Range("E" & NewRow).Formula = _
"=IF(ISERROR(" & Lookup4Str & "),""""," & Lookup4Str & ")"
'copy formula down column B for each unique name
Range("B" & NewRow & ":E" & NewRow).Copy _
Destination:=Range("B" & NewRow & ":B" & LastRowUnique)
End Sub
--
joel
------------------------------------------------------------------------
joel's Profile:
http://www.thecodecage.com/forumz/member.php?u=229
View this thread:
http://www.thecodecage.com/forumz/sh...d.php?t=198519
http://www.thecodecage.com/forumz