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

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$" & 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
>
> .
>

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/sh...d.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$" & 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
>
> .
>