Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations gkittelson on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

macro to tranpose data

Status
Not open for further replies.

Brianfree

Programmer
Feb 6, 2008
220
GB
Hi, I am looking for a macro or something to transpose excel data... Please see example below..

Start Data

col1 col2
123 abc
456 abc
789 abc
111 def
222 def
456 ghi
789 jkl
123 mno
444 pqr
554 pqr
678 pqr
987 pqr
654 pqr
321 pqr
656 pqr
788 pqr

col1 col2 col3 etc......
abc 123 456 789
def 111 222
ghi 456
jkl 789
mno 123
pqr 444 554 678 987 654 321 656 788


Please can anyone help?

thankyou
Brian F
 
Hi

You can do this by 1) making a unique list of col1 2) using OFFSET(), INDEX(), MATCH(), COUNTIF(), COLUMN() to return the value of interest


Skip,

[glasses]Just traded in my OLD subtlety...
for a NUance![tongue]
 

here are my results
[pre]
1 2 3 4 5 6 7 8 9
abc 123 456 789 #REF! #REF! #REF! #REF! #REF! #REF!
def 111 222 #REF! #REF! #REF! #REF! #REF! #REF! #REF!
ghi 456 #REF! #REF! #REF! #REF! #REF! #REF! #REF! #REF!
jkl 789 #REF! #REF! #REF! #REF! #REF! #REF! #REF! #REF!
mno 123 #REF! #REF! #REF! #REF! #REF! #REF! #REF! #REF!
pqr 444 554 678 987 654 321 656 788 #REF!
[/pre]
The formula using named ranges with your example heading
[tt]
=INDEX(OFFSET(col1_,MATCH($A2,col2_,0)-1,0,COUNTIF(col2_,$A2),1),B$1)
[/tt]

The #REF! can be easily hndles with the IFERROR() function.

Skip,

[glasses]Just traded in my OLD subtlety...
for a NUance![tongue]
 
This macro (not that simple like Skip's formula):

Code:
Sub Macro1()
Dim r As Integer
Dim r2 As Integer
Dim c2 As Integer
Dim strCol2 As String

r2 = 1
c2 = 1
r = 2
strCol2 = Sheets(1).Range("B" & r).Value

Do While Sheets(1).Range("B" & r).Value <> ""
    If strCol2 <> Sheets(1).Range("B" & r).Value Then
        strCol2 = Sheets(1).Range("B" & r).Value
        r2 = r2 + 1
        c2 = 1
    End If
    
    Sheets(2).Range("A" & r2).Value = strCol2
    Sheets(2).Cells(r2, c2 + 1).Value = Sheets(1).Range("A" & r).Value
    c2 = c2 + 1
    
    r = r + 1
Loop

End Sub

produces this in Sheet2:

[pre]
abc 123 456 789
def 111 222
ghi 456
jkl 789
mno 123
pqr 444 554 678 987 654 321 656 788
[/pre]


Have fun.

---- Andy

A bus station is where a bus stops. A train station is where a train stops. On my desk, I have a work station.
 
Code questions in forum707 please.


Skip,

[glasses]Just traded in my OLD subtlety...
for a NUance![tongue]
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top