Results 1 to 3 of 3
  1. #1
    Lounger
    Join Date
    Apr 2006
    Location
    Dublin, Ireland, Republic of
    Posts
    30
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Conditional transpose Colomn to Rows (2003)

    I have a sheet with 2 colums (A & [img]/forums/images/smilies/cool.gif[/img]. Column A contains names, Colum B contains a subject.
    A B
    John Maths
    John Art
    Michael History
    Anne French
    John English
    Michael maths

    I want to transpose the column so that for each unique in A all of the subjects in b will be transposed into rows..

    John maths Art English
    Michael maths history
    Anne french

  2. #2
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts

    Re: Conditional transpose Colomn to Rows (2003)

    Does this do what you want? I do not overwrite the current sheet but add the rearranged data on a separate sheet. You can copy and paste it where you want.

    Steve

    <pre>Option Explicit
    Sub CondTranspose()
    Dim rAll As Range
    Dim rCell As Range
    Dim wStart As Worksheet
    Dim rList As Range
    Dim wNew As Worksheet
    Dim lRow As Long
    Dim iCol As Integer
    Dim lNextRow As Long
    Dim AWF As WorksheetFunction

    Set AWF = Application.WorksheetFunction

    Set wStart = ActiveSheet
    With wStart
    Set rAll = .Range(.Range("A1"), _
    .Range("a65536").End(xlUp))
    End With
    Set wNew = Worksheets.Add
    lNextRow = 1
    With wNew
    For Each rCell In rAll
    Set rList = .Range(.Range("A1"), _
    .Range("A65536").End(xlUp))
    lRow = 0
    On Error Resume Next
    lRow = AWF.Match(rCell.Value, rList, 0)
    On Error GoTo 0
    If lRow = 0 Then
    lRow = lNextRow
    lNextRow = lNextRow + 1
    .Cells(lRow, 1) = rCell.Value
    iCol = 2
    Else
    iCol = 1 + .Cells(lRow, 256).End(xlToLeft).Column
    End If
    .Cells(lRow, iCol) = rCell.Offset(0, 1).Value
    Next
    End With

    Set rCell = Nothing
    Set rAll = Nothing
    Set rList = Nothing
    Set wStart = Nothing
    Set wNew = Nothing
    Set AWF = Nothing
    End Sub</pre>


  3. #3
    Lounger
    Join Date
    Apr 2006
    Location
    Dublin, Ireland, Republic of
    Posts
    30
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Conditional transpose Colomn to Rows (2003)

    This does exactly what I need.

    Thanks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •