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)),"",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

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)),"",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

.

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

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

.

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

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

.