macro: change in value & transpose data

[quercus]

Hello All,

Just wondering whether anybody can help me with a macro question?

I have two columns of data, for example as follows:

<table border="0" cellpadding="0" cellspacing="0" width="161"><colgroup><col style="width:48pt" width="64"> <col style="mso-width-source:userset;mso-width-alt:1206;width:25pt" width="33"> <col style="width:48pt" width="64"> </colgroup><tbody><tr style="height:15.0pt" height="20"> <td colspan="2" style="height:15.0pt;mso-ignore:colspan; width:73pt" height="20" width="97">Module_code</td> <td style="width:48pt" width="64">Old_topic_code</td> </tr> <tr style="height:15.0pt" height="20"> <td style="height:15.0pt" height="20">GR321M</td> <td>
</td> <td>GR321</td> </tr> <tr style="height:15.0pt" height="20"> <td style="height:15.0pt" height="20">GR321M</td> <td>
</td> <td>GR322</td> </tr> <tr style="height:15.0pt" height="20"> <td style="height:15.0pt" height="20">GR321M</td> <td>
</td> <td>GR323</td> </tr> <tr style="height:15.0pt" height="20"> <td style="height:15.0pt" height="20">GR321M</td> <td>
</td> <td>GR320X</td> </tr> <tr style="height:15.0pt" height="20"> <td style="height:15.0pt" height="20">GR322M</td> <td>
</td> <td>GR324</td> </tr> <tr style="height:15.0pt" height="20"> <td style="height:15.0pt" height="20">GR322M</td> <td>
</td> <td>GR325</td> </tr> <tr style="height:15.0pt" height="20"> <td style="height:15.0pt" height="20">GR322M</td> <td>
</td> <td>GR326</td> </tr> <tr style="height:15.0pt" height="20"> <td style="height:15.0pt" height="20">GR320E</td> <td>
</td> <td>GR320X</td> </tr> <tr style="height:15.0pt" height="20"> <td style="height:15.0pt" height="20">GR001M</td> <td>
</td> <td>GR001</td> </tr> <tr style="height:15.0pt" height="20"> <td style="height:15.0pt" height="20">GR001M</td> <td>
</td> <td>GR002</td> </tr> <tr style="height:15.0pt" height="20"> <td style="height:15.0pt" height="20">GR001M</td> <td>
</td> <td>GR003</td> </tr> <tr style="height:15.0pt" height="20"> <td style="height:15.0pt" height="20">GR001M</td> <td>
</td> <td>GR004</td> </tr> <tr style="height:15.0pt" height="20"> <td style="height:15.0pt" height="20">GR001M</td> <td>
</td> <td>GR005</td> </tr> <tr style="height:15.0pt" height="20"> <td style="height:15.0pt" height="20">GR002M</td> <td>
</td> <td>GR006</td> </tr> <tr style="height:15.0pt" height="20"> <td style="height:15.0pt" height="20">GR002M</td> <td>
</td> <td>GR007</td> </tr> </tbody></table>

I would like to transpose the data, so that all the values in column Old_Topic_Code are detailed in the same row as the relevant module code, for example the output for GR321M and GR322M would be as follows:

<table border="0" cellpadding="0" cellspacing="0" width="353"><colgroup><col style="width:48pt" width="64"> <col style="mso-width-source:userset;mso-width-alt:1206;width:25pt" width="33"> <col style="width:48pt" span="4" width="64"> </colgroup><tbody><tr style="height:15.0pt" height="20"> <td class="xl65" colspan="2" style="height:15.0pt;mso-ignore: colspan;width:73pt" height="20" width="97">Module_code</td> <td class="xl65" colspan="2" style="mso-ignore:colspan;width:96pt" width="128">Old_topic_code</td> <td style="width:48pt" width="64">
</td> <td style="width:48pt" width="64">
</td> </tr> <tr style="height:15.0pt" height="20"> <td style="height:15.0pt" height="20">GR321M</td> <td>
</td> <td>GR321</td> <td>GR322</td> <td>GR323</td> <td>GR320X</td> </tr> <tr style="height:15.0pt" height="20"> <td style="height:15.0pt" height="20">GR322M</td> <td>
</td> <td>GR324</td> <td>GR325</td> <td>GR326</td> <td>
</td> </tr> </tbody></table><table border="0" cellpadding="0" cellspacing="0" height="40" width="349"><tbody><tr style="height:15.0pt" height="20"><td style="height:15.0pt" height="20">
</td><td>
</td><td>
</td><td>
</td><td>
</td><td>
</td></tr></tbody></table>This would then continue down the sheet, and each unique value in column Module_code would then detail the associated Old_topic_code values. As I have thousands of rows of data, the only way I can do this would be a macro, but just not sure how.

All assistance greatly appreciated!

Thanks
quercus

 

[Domenic]

Assuming that Column A and Column B contain the data, make sure the sheet containing the data is the active sheet and try the following macro...

[font=Verdana][color=darkblue]Option[/color] [color=darkblue]Explicit[/color]

[color=darkblue]Sub[/color] test()

    [color=darkblue]Dim[/color] LastRow [color=darkblue]As[/color] [color=darkblue]Long[/color]
    [color=darkblue]Dim[/color] i [color=darkblue]As[/color] [color=darkblue]Long[/color]
    
    LastRow = Cells(Rows.Count, "A").End(xlUp).Row
    
    [color=darkblue]If[/color] LastRow = 1 [color=darkblue]Then[/color]
        MsgBox "No data is available...", vbExclamation
        [color=darkblue]Exit[/color] [color=darkblue]Sub[/color]
    [color=darkblue]End[/color] [color=darkblue]If[/color]
    
    Application.ScreenUpdating = [color=darkblue]False[/color]
    
    [color=darkblue]With[/color] Range("A1:B" & LastRow)
        .Sort key1:=Range("A1"), Order1:=xlAscending, key2:=Range("B1"), Order2:=xlAscending, _
            Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTop[color=darkblue]To[/color]Bottom
    [color=darkblue]End[/color] [color=darkblue]With[/color]
    
    [color=darkblue]For[/color] i = LastRow To 3 [color=darkblue]Step[/color] -1
        [color=darkblue]If[/color] Cells(i, "A").Value = Cells(i - 1, "A").Value [color=darkblue]Then[/color]
            Range(Cells(i, "B"), Cells(i, Columns.Count).End(xlToLeft)).Copy Cells(i - 1, "C")
            Rows(i).Delete
        [color=darkblue]End[/color] [color=darkblue]If[/color]
    [color=darkblue]Next[/color] i
    
    Application.ScreenUpdating = [color=darkblue]True[/color]
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color]
[/font]

 

[quercus]

Absolutely perfect - thank you Domenic

 

[Domenic]

You're very welcome! Thanks for the feedback!