View Single Post
  #7   Report Post  
Posted to microsoft.public.excel.programming
George George is offline
external usenet poster
 
Posts: 347
Default Compare Names in a column and create single list with adjacent

Joel,

Sorry for the delay, This worked perfect...Thanks again.

"joel" wrote:


The changes you asked for were pretty simple to make. i didn't test the
changes but I'm pretty confident they should work. I used Pastespecial
to remove the formulas and then deleted the rows with the original data.
I had to replace the values otherwise when I delete the orginal data
the formulas data would be lost.

Using formulas like this makes the macro run quicker than other methods.
It looks like a lot of code, but if you look closely I just repeating
the same basic method over and over again. It only takes me about 10
minutes to write this macro. It probably would take you hours.

I wasn't sure when I wrote the macro if you had a header row or didn't
have a header row. To remove the headers I changed some of the copy
methods to start at row 2 instead of row 1.


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("A2: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("C2: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("E2:E" & LastRow).Copy _
Destination:=Range("IV" & (LastRowNewData + 1))
'get last row of new data
LastRowNewData = Range("IV" & Rows.Count).End(xlUp).Row
Range("G2: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

'Put Headers above row
Range("B" & (NewRow - 1)) = "Data 1"
Range("C" & (NewRow - 1)) = "Data 2"
Range("D" & (NewRow - 1)) = "Data 3"
Range("E" & (NewRow - 1)) = "Data 4"

'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$2:A$4,2,False)),"",VLOO KUP(A10,A$2:A$4,2,False))
'=IF(ISERROR(VLOOKUP(A10,C$2:C$4,2,False)),"",VLOO KUP(A10,C$2:C$4,2,False))
'=IF(ISERROR(VLOOKUP(A10,E$2:E$4,2,False)),"",VLOO KUP(A10,E$2:E$4,2,False))
'=IF(ISERROR(VLOOKUP(A10,G$2:G$4,2,False)),"",VLOO KUP(A10,G$2:G$4,2,False))

Lookup1Str = "VLookup(A" & NewRow & ",A$2:B$" & LastRow & ",2,False)"
Lookup2Str = "VLookup(A" & NewRow & ",C$2:D$" & LastRow & ",2,False)"
Lookup3Str = "VLookup(A" & NewRow & ",E$2:F$" & LastRow & ",2,False)"
Lookup4Str = "VLookup(A" & NewRow & ",G$2: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)

'replace formulas with values
Rows(NewRow & ":" & LastRowUnique).Copy
Rows(NewRow & ":" & LastRowUnique).PasteSpecial _
Paste:=xlPasteValues

'delete orignal data
Rows("1:" & (NewRow - 2)).Delete
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

.