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

 

[jindon]

try

Sub test()
Dim myAreas As Areas, myArea As Range
With Sheets("sheet1")
    With .Range("a1", .Range("a" & Rows.Count).End(xlUp))
        On Error Resume Next
        Set myAreas = .SpecialCells(2).Areas
        On Error GoTo 0
        If myAreas Is Nothing Then Exit Sub
        For Each myArea In myAreas
            n = n + 1
            If myArea.Rows.Count > 1 Then
                Sheets("sheet2").Cells(n,1).Resize(,myArea.Rows.Count).Value = _
                Evaluate("transpose(sheet1!" & myArea.Address & ")")
            Else
                Sheets("sheet2").Cells(n,1).Value = myArea.Value
            End If
        Next
    End With
End With
End Sub

 

[ineedadedt]

Jindon,

Thanks for the quick reply. It's 99% done, I just have one small change. I didn't realize when the data in sheet one is pasted, there is a line in between the name and the title. So it looks like the following:

Eric
blank space
Title
President
Email
eric@abc.com

Anyway to make the macro delete the row before the "title" line? That would then make everything compact and paste the data exactly how I need it!

Thanks so much!!

 

[jindon]

Change

        For Each myArea In myAreas
            n = n + 1
            If myArea.Rows.Count > 1 Then
                Sheets("sheet2").Cells(n,1).Resize(,myArea.Rows.Count).Value = _
                Evaluate("transpose(sheet1!" & myArea.Address & ")")
            Else
                Sheets("sheet2").Cells(n,1).Value = myArea.Value
            End If
        Next

to

        For Each myArea In myAreas
            If (myArea.Rows.Count > 1) * (n > 0) Then
                Sheets("sheet2").Cells(n,2).Resize(,myArea.Rows.Count).Value = _
                Evaluate("transpose(sheet1!" & myArea.Address & ")")
            Else
                n = n + 1
                Sheets("sheet2").Cells(n,1).Value = myArea.Value
            End If
        Next

 

[ineedadedt]

Jindon,

Like always you are the best!!!! Thank you so much!

 

[dhavalmalvania]

can u tell me if I have a whole excel file containing different things with reference to your this function which was quite helpful i need to make is possible for the things to say like
[TABLE="width: 1920"]
<colgroup><col><col><col span="16"></colgroup><tbody>[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Company Name
[/TD]
[TD]RAVASCO TRANSMISSION & PACKING PVT. LTD.[/TD]
[TD]Company Name RAVASCO TRANSMISSION & PACKING PVT. LTD.[/TD]
[TD]Company Name RAVASCO TRANSMISSION & PACKING PVT. LTD.[/TD]
[TD]Company Name RAVASCO TRANSMISSION & PACKING PVT. LTD.[/TD]
[TD]Address 1, JANKI CENTRE, OFF. VEERA DESAI ROAD, ANDHERI (WEST), Mumbai - 400053, Maharashtra, India[/TD]
[TD]Phone No 91-22-26730890/26730892/26730891/32168400/32168401/32168402[/TD]
[TD]Fax 91-22-26730889/26901940/26391975/66916245[/TD]
[TD]Contact Person Mr. Rajesh Ranjan (Marketing Manager)[/TD]
[TD]Mobile 9321224493[/TD]
[TD] [/TD]
[TD] [/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Address [/TD]
[TD]1, JANKI CENTRE, OFF. VEERA DESAI ROAD, ANDHERI (WEST), Mumbai - 400053, Maharashtra, India[/TD]
[TD]Address 1, JANKI CENTRE, OFF. VEERA DESAI ROAD, ANDHERI (WEST), Mumbai - 400053, Maharashtra, India[/TD]
[TD="colspan: 11"]Address 1, JANKI CENTRE, OFF. VEERA DESAI ROAD, ANDHERI (WEST), Mumbai - 400053, Maharashtra, India[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Phone No [/TD]
[TD]91-22-26730890/26730892/26730891/32168400/32168401/32168402[/TD]
[TD]Phone No 91-22-26730890/26730892/26730891/32168400/32168401/32168402[/TD]
[TD="colspan: 8"]Phone No 91-22-26730890/26730892/26730891/32168400/32168401/32168402[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Fax [/TD]
[TD]91-22-26730889/26901940/26391975/66916245[/TD]
[TD]Fax 91-22-26730889/26901940/26391975/66916245[/TD]
[TD="colspan: 5"]Fax 91-22-26730889/26901940/26391975/66916245[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Contact Person [/TD]
[TD]Mr. Rajesh Ranjan (Marketing Manager)[/TD]
[TD]Contact Person Mr. Rajesh Ranjan (Marketing Manager)[/TD]
[TD="colspan: 6"]Contact Person Mr. Rajesh Ranjan (Marketing Manager)[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Mobile [/TD]
[TD="align: right"]9321224493[/TD]
[TD]Mobile 9321224493[/TD]
[TD="colspan: 2"]Mobile 9321224493[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD] [/TD]
[TD] [/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD] [/TD]
[TD] [/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Company Name [/TD]
[TD="align: left"]

BHAVANI INDUSTRIES

<tbody>
</tbody>

[/TD]
[TD]Company Name BHAVANI INDUSTRIES[/TD]
[TD="colspan: 4"]Company Name BHAVANI INDUSTRIES[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Address [/TD]
[TD]A-1, SHARMA COMPOUND KOPERGAON ESTATE, OPP. MAZGAON TELEPHONE EXCHANGE, LOVE LANE, Mumbai - 400033, Maharashtra, India[/TD]
[TD]Address A-1, SHARMA COMPOUND KOPERGAON ESTATE, OPP. MAZGAON TELEPHONE EXCHANGE, LOVE LANE, Mumbai - 400033, Maharashtra, India[/TD]
[TD="colspan: 15"]Address A-1, SHARMA COMPOUND KOPERGAON ESTATE, OPP. MAZGAON TELEPHONE EXCHANGE, LOVE LANE, Mumbai - 400033, Maharashtra, India[/TD]
[/TR]
[TR]
[TD]Phone No [/TD]
[TD]91-22-23720725[/TD]
[TD]Phone No 91-22-23720725[/TD]
[TD="colspan: 3"]Phone No 91-22-23720725[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Fax [/TD]
[TD]91-22-23720725[/TD]
[TD]Fax 91-22-23720725[/TD]
[TD="colspan: 2"]Fax 91-22-23720725[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Contact Person [/TD]
[TD]Mr. Kirit Chitroda (Director)[/TD]
[TD]Contact Person Mr. Kirit Chitroda (Director)[/TD]
[TD="colspan: 5"]Contact Person Mr. Kirit Chitroda (Director)[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Mobile [/TD]
[TD="align: right"]9833081827[/TD]
[TD]Mobile 9833081827[/TD]
[TD="colspan: 2"]Mobile 9833081827[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Contact Person [/TD]
[TD]Mr. Vijay Chitroda[/TD]
[TD]Contact Person Mr. Vijay Chitroda[/TD]
[TD="colspan: 4"]Contact Person Mr. Vijay Chitroda[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD="align: right"]9820237583[/TD]
[TD] 9820237583[/TD]
[TD="colspan: 2"] 9820237583[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD] [/TD]
[TD] [/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD] [/TD]
[TD] [/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Company Name [/TD]
[TD]JAGDAMB ENTERPRISES[/TD]
[TD]Company Name JAGDAMB ENTERPRISES[/TD]
[TD="colspan: 4"]Company Name JAGDAMB ENTERPRISES[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Address [/TD]
[TD]SHOP NO.9, GANESH KRUPA, AAREY ROAD, NEAR SUBWAY, GOREGAON (W), Mumbai - 400062, Maharashtra, India[/TD]
[TD]Address SHOP NO.9, GANESH KRUPA, AAREY ROAD, NEAR SUBWAY, GOREGAON (W), Mumbai - 400062, Maharashtra, India[/TD]
[TD="colspan: 12"]Address SHOP NO.9, GANESH KRUPA, AAREY ROAD, NEAR SUBWAY, GOREGAON (W), Mumbai - 400062, Maharashtra, India[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Phone No [/TD]
[TD]91-22-28711123
[/TD]
[TD]Phone No 91-22-28711123[/TD]
[TD="colspan: 3"]Phone No 91-22-28711123[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Contact Person [/TD]
[TD]Mr. Sanjay Danti (Proprietor)[/TD]
[TD]Contact Person Mr. Sanjay Danti (Proprietor)[/TD]
[TD="colspan: 5"]Contact Person Mr. Sanjay Danti (Proprietor)[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Mobile [/TD]
[TD="align: right"]9967439794[/TD]
[TD]Mobile 9967439794[/TD]
[TD="colspan: 2"]Mobile 9967439794[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD] [/TD]
[TD] [/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
to another column position starting from in E column to respective rows and also should come down to the row consistantly.
for further details please email me or PM me. its really urgent required.


regards thanks
Dhaval

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

 

[dhavalmalvania]

can u please send me the excel sheet with example as i m also looking for the same and working on it with so much of data and whole lot of 100 sheets i need to transpose to....so it will be much helpful to ....as i tried the code provided by the jindon but that give all in only single row and then wat to do for skipping all this blank in between please let me know

Jindon,

Like always you are the best!!!! Thank you so much!