I want to Transpose Data

[hari_ghk]

I have a data set in Excel 2003 which looks like this:

<table border="0" cellpadding="0" cellspacing="0" width="105"><colgroup><col style="mso-width-source:userset;mso-width-alt:2005;width:35pt" width="47"> <col style="mso-width-source:userset;mso-width-alt:2474;width:44pt" width="58"> </colgroup><tbody><tr style="height:12.0pt" height="16"> <td class="xl22" style="height:12.0pt;width:35pt" height="16" width="47">Name</td> <td class="xl22" style="width:44pt" width="58">Qualification</td> </tr> <tr style="height:12.0pt" height="16"> <td style="height:12.0pt" height="16">Kalyani</td> <td>Graduate</td> </tr> <tr style="height:12.0pt" height="16"> <td style="height:12.0pt" height="16">Kalyani</td> <td>PostGrad</td> </tr> <tr style="height:12.0pt" height="16"> <td style="height:12.0pt" height="16">Kalyani</td> <td>Doctrate</td> </tr> <tr style="height:12.0pt" height="16"> <td style="height:12.0pt" height="16">Hari</td> <td>Graduate</td> </tr> <tr style="height:12.0pt" height="16"> <td style="height:12.0pt" height="16">Hari</td> <td>Doctrate</td> </tr> </tbody></table>
I want the data transposed in the following manner. Kindly write a Macro to achieve this problem.

Kalyani Graduate PostGrad Doctrate
Hari Graduate PostGrad Docrate

This requirement is urgent.

Thanking you.

 

[Mike Blackman]

Hi,

Maybe somethis like this?

Sub TransposeData()

    Dim lngLastRow As Long, lngRow As Long, lngRecord As Long
    
    lngLastRow = Range("A" & Rows.Count).End(xlUp).Row
    
    For lngRow = 2 To lngLastRow
        If Application.CountIf(Columns("D"), Range("A" & lngRow)) > 0 Then
            lngRecord = Application.Match(Range("A" & lngRow), Columns("D"), 0)
            Cells(lngRecord, Columns.Count).End(xlToLeft).Offset(0, 1) = Range("B" & lngRow)
        Else
            Range("D" & Rows.Count).End(xlUp).Offset(1) = Range("A" & lngRow)
            Range("D" & Rows.Count).End(xlUp).Offset(0, 1) = Range("B" & lngRow)
        End If
    Next lngRow
    
End Sub

Assumptions: Columns D & E are both blank and data is in Columns A & B

 

[hiker95]

hari_ghk,


Welcome to the MrExcel forum.


Sample data before the macro:

Excel Workbook
	A	B	C	D	E	F	G
1	Name	Qualification
2	Kalyani	Graduate
3	Kalyani	PostGrad
4	Kalyani	Doctrate
5	Hari	Graduate
6	Hari	Doctrate
7
Sheet1

After the macro:

Excel Workbook
	A	B	C	D	E	F	G
1	Name	Qualification		Name	Graduate	PostGrad	Doctrate
2	Kalyani	Graduate		Kalyani	Graduate	PostGrad	Doctrate
3	Kalyani	PostGrad		Hari	Graduate		Doctrate
4	Kalyani	Doctrate
5	Hari	Graduate
6	Hari	Doctrate
7
Sheet1

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).


1. Copy the below code, by highlighting the code and pressing the keys CTRL + C
2. Open your workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Option Explicit
Sub ReorgData()
' hiker95, 04/06/2011
' http://www.mrexcel.com/forum/showthread.php?t=541491
Dim NR As Long, FC As Long
Dim c As Range
Application.ScreenUpdating = False
Columns("D:G").ClearContents
Range("D1:G1") = [{"Name","Graduate","PostGrad","Doctrate"}]
NR = 1
For Each c In Range("A2", Range("A" & Rows.Count).End(xlUp))
  If c.Value <> c.Offset(-1).Value Then
    NR = NR + 1
    Cells(NR, 4) = c
    FC = Application.Match(c.Offset(, 1).Value, Rows(1), 0)
    Cells(NR, FC) = Cells(1, FC)
  Else
    FC = Application.Match(c.Offset(, 1).Value, Rows(1), 0)
    Cells(NR, FC) = Cells(1, FC)
  End If
Next c
Columns("D:G").AutoFit
Application.ScreenUpdating = True
End Sub

Then run the ReorgData macro.

 

[hari_ghk]

hari_ghk,


Welcome to the MrExcel forum.


Sample data before the macro:

Excel Workbook
	A	B	C	D	E	F	G
1	Name	Qualification
2	Kalyani	Graduate
3	Kalyani	PostGrad
4	Kalyani	Doctrate
5	Hari	Graduate
6	Hari	Doctrate
7
Sheet1

After the macro:

Excel Workbook
	A	B	C	D	E	F	G
1	Name	Qualification		Name	Graduate	PostGrad	Doctrate
2	Kalyani	Graduate		Kalyani	Graduate	PostGrad	Doctrate
3	Kalyani	PostGrad		Hari	Graduate		Doctrate
4	Kalyani	Doctrate
5	Hari	Graduate
6	Hari	Doctrate
7
Sheet1

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).


1. Copy the below code, by highlighting the code and pressing the keys CTRL + C
2. Open your workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Option Explicit
Sub ReorgData()
' hiker95, 04/06/2011
' http://www.mrexcel.com/forum/showthread.php?t=541491
Dim NR As Long, FC As Long
Dim c As Range
Application.ScreenUpdating = False
Columns("D:G").ClearContents
Range("D1:G1") = [{"Name","Graduate","PostGrad","Doctrate"}]
NR = 1
For Each c In Range("A2", Range("A" & Rows.Count).End(xlUp))
  If c.Value <> c.Offset(-1).Value Then
    NR = NR + 1
    Cells(NR, 4) = c
    FC = Application.Match(c.Offset(, 1).Value, Rows(1), 0)
    Cells(NR, FC) = Cells(1, FC)
  Else
    FC = Application.Match(c.Offset(, 1).Value, Rows(1), 0)
    Cells(NR, FC) = Cells(1, FC)
  End If
Next c
Columns("D:G").AutoFit
Application.ScreenUpdating = True
End Sub

Then run the ReorgData macro.

Thank you for the code, the data elements works fine but the heading should look like this [Name Qualification].

<table border="0" cellpadding="0" cellspacing="0" width="214"><col style="mso-width-source:userset;mso-width-alt:2005;width:35pt" width="47"> <col style="mso-width-source:userset;mso-width-alt:2474;width:44pt" width="58"> <col style="width:42pt" width="56"> <col style="mso-width-source:userset;mso-width-alt:2261;width:40pt" width="53"> <tr style="height:12.0pt" height="16"> <td style="height:12.0pt;width:35pt" height="16" width="47">Name</td> <td colspan="2" style="mso-ignore:colspan;width:86pt" width="114">Qualification</td> <td style="width:40pt" width="53">
</td> </tr> <tr style="height:12.0pt" height="16"> <td style="height:12.0pt" height="16">Kalyani</td> <td>Graduate</td> <td>PostGrad</td> <td>Doctrate</td> </tr> <tr style="height:12.0pt" height="16"> <td style="height:12.0pt" height="16">Hari</td> <td>Graduate</td> <td>PostGrad</td> <td>
</td> </tr> </table>

 

[hari_ghk]

I have modified the code now and it is working perfectly.

Thank you once again for the timely help.

Cheers