transpose macro for erratic data

[Jayeen]

Hi,

I am in desperate need for some help to write a code for macro that will transpose data from rows to columns

e.g.

TAN KOON TECK
64 JALAN SEMBILANG DUA KAW 7
OFF JALAN TELOK PULAI
**blank**
**blank**
41100
KLANG
**blank**
next entry

There are blank rows in between the address, and 1 blank row between new entry.

Furthermore, the blank rows between the address are not consistent

e.g.
AZAKI B ISHAK
PT 26 PEKAN JELAWAT
**blank**
**blank**
**blank**
16070
JELAWAT

I am wondering if there is a code that could execute a macro to transpose such data automatically instead of me transposing it one by one?

Thanks a lot

JAYEEN

 

[mikerickson]

There is a traspose option for Paste Special.

 

[Jayeen]

S.O.S. transpose macro

Hi,

I know of the function however using that function, I have to transpose the data one by one. Is there a macro code which I can use to transpose all data in one shot?

I found one in your archive

Dim rng As Range
Dim i As Long
Dim j As Long
Set rng = Cells(Rows.Count, 1).End(xlUp)
j = 1
For i = 1 To rng.Row Step 10
Cells(j, "B").Resize(1, 5).Value = _
Application.Transpose(Cells(i, "A").Resize(6, 1))
j = j + 1
Next
End Sub

however, this is only applicable to address without blank rows in between
e.g.
Health Centre, Thornhill
Vicky CHOWES
Hospital Campus,
ETOBICOKE, M9V 1R8
Tel:9167973565

but mine has blank rows in between

TAN KOON TECK
64 JALAN SEMBILANG DUA KAW 7
OFF JALAN TELOK PULAI
**blank**
**blank**
41100
KLANG

what more, the numbers of blank rows are not consistent
AZAKI B ISHAK
PT 26 PEKAN JELAWAT
**blank**
**blank**
**blank**
16070
JELAWAT

Is there any command to ask macro to transpose these in one go?

Thanks

JAYEEN

 

[ravishankar]

Hi
Paste the following codes in the macro window (Alt f8)

x= cells(rows.count,1).end(xlUp).row
y = cells(1,columns.count).end(xltoleft).column
for a = 1 to x
for b = 1 to y
cells(b,a +y) = cells(a,b)
next b
next a

run the macro. you can substitute the values of x and y if you know how many rows and columns are present in the data
Ravi

 

[Jayeen]

hi Ravi,

Thanks for the speedy reply. I posted your macro and ran it, but nothing happened.

There are 7 lines altogether in my address with inconsistent blank rows between them. And, one blank row before the next entry

How can I create a macro that ignore the blank rows and treat it as containing data so as to transpose the entire data

Thanks

JAYEEN

 

[ravishankar]

Hi
My macro mechanically transposes A x B table into B x A table. does not bother about blank rows. I can't figure out why are unable to use it. Try it again.
Ravi

 

[Jayeen]

Thanks Ravi,
I think I managed to run it now, however, what I don't understand is why after transposing the data, my 2 separate entries of address were squeeze in one row

Can I transpose one entry into one row?

Thanks

JAYEEN

 

[ravishankar]

HI
Pl give me example of where it has merged data. It may overwrite if col nos are not proper. but it can not merge.
Ravi

 

[Joe Was]

Try this. It asks you to select your data range [it can also use the current selection by default]. Then it asks you to select the Top-Left cell of the range you want to Transpose to. And, does the transpose for you!


Sub myTPoseSel()
'Standard module code like: Module1.
Dim lngFirstRSel&, lngLastRSel&, lngFirstCSel&, lngLastCSel&
Dim objTopLeftDest As Object, objSel As Object
Dim lngColOffSet&, lngRowOffSet&
Dim lngRDest&, lngCDest&
Dim lngThisR&, lngThisC&

'Get Data Range to Transpose, by default use current selection!
Set objSel = Application.InputBox(prompt:="Select the data ""Range"" you want to Transpose:", _
Default:=Selection.Address, _
Title:="Get Transpose Data!", _
Type:=8)

lngFirstRSel = objSel.Row
lngLastRSel = (objSel.Rows.Count + lngFirstRSel) - 1

lngFirstCSel = objSel.Column
lngLastCSel = (objSel.Columns.Count + lngFirstCSel) - 1

'Get location to transpose to!
Set objTopLeftDest = Application.InputBox(prompt:="Next: " & vbLf & vbLf & _
"Select the Top Left Cell to Transpose to:", _
Title:="Get Transpose Destination!", _
Type:=8)

lngRDest = objTopLeftDest.Row
lngCDest = objTopLeftDest.Column

'Transpose!
For lngThisR = lngFirstRSel To lngLastRSel
For lngThisC = lngFirstCSel To lngLastCSel

Cells(lngRDest + lngRowOffSet, lngCDest + lngColOffSet) = Cells(lngThisR, lngThisC)
lngRowOffSet = lngRowOffSet + 1
Next lngThisC

lngRowOffSet = 0
lngColOffSet = lngColOffSet + 1
Next lngThisR
End Sub

 

[ineedadedt]

Hi All,

I found this code and I think it will work well for me, however I need a few things modified.
1. I need the information it transposes to go into sheet 2.
2. I need clumps of information to go to the next row, not stay in the same row. e.g.
Column A
Eric
President
eric@abc.com
www.abc.com
blank space here
blank space here
Rich
President
rich@abc.com
www.abc.com
blank space here
blank space here
blank space here
Another cluster of info.

Ideally, this information would paste into sheet 2 like this:
eric president eric@abc.com www.abc.com
rich president rich@abc.com www.abc.com
another set of info

Any help is greatly appreciated!

Eric