Good Morning,

Here's the challenge the information shown below is on a single worksheet. 
What I need to do is create a single column of names from Columns A,C,E,G. 
The adjacent columns B, D, F, H contains values associated with each name and 
need to be added next to the proper name in the new list...Below I added what 
is looks like currently and how it need to look after run the macro or VB 
script.  

Col A      Data1    Col C        Data 2     Col E      Data 3   Col G     
Data 4
Name1    0.3       Name1      100%    Name 1     15      Name1     0.1
Name2    0.5       Name2      10%      Name 2     12      Name2     0.2
Name3    0.7       Name3      90%      Name 4     18      Name4     0.3
Name4    0.7       Name4      90%      Name 5     18      Name5     0.3

Below is how the result should look

Col A      Data1    Data 2     Data 3     Data 4
Name1    0.3        100%       15          0.1
Name2    0.5        10%         12          0.2
Name3    0.7        90%      
Name4    0.7        90%         18          0.3
Name5                                18          0.3

Thank You in Advance for any assistance..
Respectfully,
George

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)),"",VLOOKUP(A10,A$1:A$4,2,False))
'=IF(ISERROR(VLOOKUP(A10,C$1:C$4,2,False)),"",VLOOKUP(A10,C$1:C$4,2,False))
'=IF(ISERROR(VLOOKUP(A10,E$1:E$4,2,False)),"",VLOOKUP(A10,E$1:E$4,2,False))
'=IF(ISERROR(VLOOKUP(A10,G$1:G$4,2,False)),"",VLOOKUP(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/showthread.php?t=198519

http://www.thecodecage.com/forumz

Hi Joel,

Thanks for your post and reference link. I ran the routine and it does place 
the names in column "A" with its adjacent values, however what I'm realyy 
needing to do is have the name listed once In Column "A" and any value having 
the same name association place it in the appropriate columns B, C, D & E 
next to the name.

So if you have any additional suggestion that would be great.

thanks again.
George

"joel" wrote:

> 
> 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)),"",VLOOKUP(A10,A$1:A$4,2,False))
> '=IF(ISERROR(VLOOKUP(A10,C$1:C$4,2,False)),"",VLOOKUP(A10,C$1:C$4,2,False))
> '=IF(ISERROR(VLOOKUP(A10,E$1:E$4,2,False)),"",VLOOKUP(A10,E$1:E$4,2,False))
> '=IF(ISERROR(VLOOKUP(A10,G$1:G$4,2,False)),"",VLOOKUP(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/showthread.php?t=198519
> 
> http://www.thecodecage.com/forumz
> 
> .
> 

Try adjusting the column widths.  The code places formulas in columns B,
C, D, & E.  Do you have the formulas?  Are you looking to put values
instead of formulas? Not sure why you aren't getting the correct
results.  The code works properly on my PC.

The code puts the results in Columns A four rows below the end of your
data.  Check to make sure there isn't anything else in column A below
your data.


-- 
joel
------------------------------------------------------------------------
joel's Profile: http://www.thecodecage.com/forumz/member.php?u=229
View this thread: http://www.thecodecage.com/forumz/showthread.php?t=198519

http://www.thecodecage.com/forumz

Hi Joel,

I really wanted just the values but the formula's are ok. I've  attached the 
results I'm getting which are close but not quite there yet. I don't want the 
headers "Col C", "Col E", & "Col G"  in the list of names in Col A.  
Additionally, I want the headers "Data 2', "Data 3" & "Data 4" at the top of 
their respective columns. Finally, the data that was used to create the list 
can be deleted.

Unique Names				
Col A	Data 1			
Name1	0.3	1	15	0.1
Name2	0.5	0.1	12	0.2
Name3	0.7	0.9		
Name4	0.7	0.9	18	0.3
Col c		Data2		
Col E			Data3	
Name5			18	0.3
Col G				Data 4


Many Thanks Again,
George

"joel" wrote:

> 
> Try adjusting the column widths.  The code places formulas in columns B,
> C, D, & E.  Do you have the formulas?  Are you looking to put values
> instead of formulas? Not sure why you aren't getting the correct
> results.  The code works properly on my PC.
> 
> The code puts the results in Columns A four rows below the end of your
> data.  Check to make sure there isn't anything else in column A below
> your data.
> 
> 
> -- 
> joel
> ------------------------------------------------------------------------
> joel's Profile: http://www.thecodecage.com/forumz/member.php?u=229
> View this thread: http://www.thecodecage.com/forumz/showthread.php?t=198519
> 
> http://www.thecodecage.com/forumz
> 
> .
> 

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)),"",VLOOKUP(A10,A$2:A$4,2,False))
'=IF(ISERROR(VLOOKUP(A10,C$2:C$4,2,False)),"",VLOOKUP(A10,C$2:C$4,2,False))
'=IF(ISERROR(VLOOKUP(A10,E$2:E$4,2,False)),"",VLOOKUP(A10,E$2:E$4,2,False))
'=IF(ISERROR(VLOOKUP(A10,G$2:G$4,2,False)),"",VLOOKUP(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/showthread.php?t=198519

http://www.thecodecage.com/forumz

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)),"",VLOOKUP(A10,A$2:A$4,2,False))
> '=IF(ISERROR(VLOOKUP(A10,C$2:C$4,2,False)),"",VLOOKUP(A10,C$2:C$4,2,False))
> '=IF(ISERROR(VLOOKUP(A10,E$2:E$4,2,False)),"",VLOOKUP(A10,E$2:E$4,2,False))
> '=IF(ISERROR(VLOOKUP(A10,G$2:G$4,2,False)),"",VLOOKUP(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/showthread.php?t=198519
> 
> http://www.thecodecage.com/forumz
> 
> .
>