Move cell data from columns to rows

[steallan]

Hi

Im after some help with a macro as im not the best when it comes to VBA.

I have values in one column and corresponding values in the next column. I wnat to move the corresponding values to a new row and have them in the row instead of the column.

hear is an example,

Workpackage 020305.csv
	B	C	D	E	F	G	H	I	J
1	MHB4200	AAH-A-0-12200
2	SWD6900	AAH-A-0-12201	MHB6000	MHB7000	MHB4300	MHB4200	MHB3100	MHB2200
3	MHB6000	AAH-A-0-12201
4	MHB7000	AAH-A-0-12201
5	MHB4300	AAH-A-0-12201
6	MHB4200	AAH-A-0-12201
7	MHB3100	AAH-A-0-12201
8	MHB2200	AAH-A-0-12201
9	MHB6000	AAH-A-0-12201scan	MHB6000	MHB7000	SWD6500	SWD6900
10	MHB7000	AAH-A-0-12201scan
11	SWD6500	AAH-A-0-12201scan
12	SWD6900	AAH-A-0-12201scan
13	MHB6000	AAH-A-0-SK0015
14	MHB4200	AAH-A-0-SK0015
15	MHB7000	AAH-A-0-SK0015
16	MHB6000	AAH-A-0-SK0016
17	MHB4200	AAH-A-0-SK0016
18	MHB7000	AAH-A-0-SK0016
19	MHB6000	AAH-A-0-SK0017
20	MHB4200	AAH-A-0-SK0017
21	MHB7000	AAH-A-0-SK0017
22	MHB6000	AAH-A-0-SK0018
Workpackage 020305

 

[scrupul0us]

Check out the function Columns to Rows

 

[steallan]

Thx
Is there a way to use this to move the data for each value in column 2?
Do you know what i mean, can you see above all the values next to a AAH-A-0-12201 were transposed next to one AAH-A-0-12201 value, then all the values next to a AAH-A-0-12201scan were transposed next to AAH-A-0-12201scan

sorry about the image above its not turned out very clear

 

[steallan]

help

 

[Norie]

Can you explain further what you are trying to do?

It really isn't clear.

By the way check out the link at the top of the forum about the &nbsp problem when posting.

 

[steallan]

Workpackage.csv
	A	B	C	D	E	F	G	H	I
1	04A088-002	U1600	U1600
2	AAH-A-0-12200	MHB4200	MHB4200
3	AAH-A-0-12201	MHB2200	MHB2200	MHB3100	MHB4200	MHB4300	MHB6000	MHB7000	SWD6900
4	AAH-A-0-12201	MHB3100
5	AAH-A-0-12201	MHB4200
6	AAH-A-0-12201	MHB4300
7	AAH-A-0-12201	MHB6000
8	AAH-A-0-12201	MHB7000
9	AAH-A-0-12201	SWD6900
10	AAH-A-0-12201scan	MHB6000	MHB6000	MHB7000	SWD6500	SWD6900
11	AAH-A-0-12201scan	MHB7000
12	AAH-A-0-12201scan	SWD6500
13	AAH-A-0-12201scan	SWD6900
14	AAH-A-0-SK0015	MHB4200	MHB4200	MHB6000	MHB7000
15	AAH-A-0-SK0015	MHB6000
16	AAH-A-0-SK0015	MHB7000
17	AAH-A-0-SK0016	MHB4200	MHB4200	MHB6000	MHB7000
18	AAH-A-0-SK0016	MHB6000
19	AAH-A-0-SK0016	MHB7000
20	AAH-A-0-SK0017	MHB4200
21	AAH-A-0-SK0017	MHB6000
22	AAH-A-0-SK0017	MHB7000
23	AAH-A-0-SK0018	MHB4200
24	AAH-A-0-SK0018	MHB6000
25	AAH-A-0-SK0018	MHB7000
26	AAH-A-0-SK0019	MHB4200
Workpackage

Hopefully thats clearer. can you see that for each file name (column A) there are values next to it in column B. these are assigned values to that file name. there can be any amount of none.

i need these values in a row instead of columned so i can cut them to another sheet.

but this list is 10000 + long and gets added to every day.

this is actually a different approach to another problem that noone could help me with

http://www.mrexcel.com/board2/viewtopic.php?t=133874&highlight=

dont no if that helps make it clearer.

thx for any ideas you've got

 

[jindon]

Hi,
try

Sub test()
Dim dic As Object, i As Long, r As Range, txt
Set dic = CreateObject("Scripting.Dictionary")
With ActiveSheet
    For Each r In .Range("a1", .Range("a65536").End(xlUp))
        If Not dic.Exists(r.Value) Then
            dic.Add r.Value, r.Offset(, 1).Value & ","
        Else
            dic.Item(r.Value) = dic.Item(r.Value) & r.Offset(, 1).Value & ","
        End If
    Next
    x = dic.keys
    For i = LBound(x) To UBound(x)
        For Each r In .Range("a1", .Range("a65536").End(xlUp))
            If r.Value = x(i) Then
                txt = Left(dic.Item(r.Value), Len(dic.Item(r.Value)) - 1): a = Split(txt, ",")
                r.Offset(, 1).Resize(, UBound(a) + 1).Value = a
                Exit For
            End If
        Next
    Next
End With
End Sub

 

[steallan]

You Star!

It works great. Thanks a million

 

[scrupul0us]

/me applauds the usefullness of the dictionary object

 

[jindon]

scrupul0us,

Thanks.

That is one the most delilghtfull comment.

rgds,
jindon