Results 1 to 6 of 6

Thread: Need Help for Rearranging Data with Macro or Formula
Thanks Thanks: 0 Likes Likes: 0

  1. #1
    New Member
    Join Date
    Jun 2007
    Posts
    17
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Question Need Help for Rearranging Data with Macro or Formula

    Hello All,

    This might be very easy for some of you. I have a data sheet like below:

    ID P1 P2 ... Pn
    1 A
    2 A B
    3 B A .... C
    .
    .

    So in each row there are different number of columns with values. Id like to arrange it into;

    ID P Rank
    1 A First
    2 A First
    2 B Last
    3 B First
    3 A 2
    3 C Last

    So the last column with a value will be labeled as last and the first as first and the rest with their ranks (relative column number to the first) or we can also say middle if it is easier to solve this way.

    Many thanks for your help. If anything is not clear, Id love to explain more.


    Cheers,

  2. #2
    MrExcel MVP
    Join Date
    Jan 2008
    Posts
    14,837
    Post Thanks / Like
    Mentioned
    26 Post(s)
    Tagged
    12 Thread(s)

    Default Re: Need Help for Rearranging Data with Macro or Formula

    Try this:-
    Results Start Sheet(2) "A1".

    Code:
    Sub MG22Nov26
    Dim Rng         As Range
    Dim Dn          As Range
    Dim AcRng       As Range
    Dim Col         As Range
    Dim Txt         As String
    Dim Num         As Long
    Dim c           As Long
    Num = ActiveSheet.Range("A1").CurrentRegion.Count
        Set Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
            ReDim Ray(1 To Num, 1 To 3)
    For Each Dn In Rng
        Set AcRng = Range(Range("B" & Dn.Row), Cells(Dn.Row, Columns.Count).End(xlToLeft))
            For Each Col In AcRng
                If Col.Column = 2 Then
                    Txt = "First"
                 ElseIf Col.Column = AcRng.Count + 1 Then
                    Txt = "Last"
                 Else
                    Txt = Col.Column - 1
                End If
                    c = c + 1
                Ray(c, 1) = Dn
                Ray(c, 2) = Col
                Ray(c, 3) = Txt
            Next Col
    Next Dn
    With Sheets("Sheet2")
    .Range("A1").Resize(, 3) = Array("ID", "P", "Rank")
    .Range("A2").Resize(c, 3) = Ray
    End With
    End Sub
    Regards Mick

  3. #3
    MrExcel MVP
    Moderator
    Peter_SSs's Avatar
    Join Date
    May 2005
    Location
    Macksville, Australia
    Posts
    40,993
    Post Thanks / Like
    Mentioned
    90 Post(s)
    Tagged
    21 Thread(s)

    Default Re: Need Help for Rearranging Data with Macro or Formula

    My attempt:


    Sub Rearrange()
      Dim a, b
      Dim rws As Long, i As Long, j As Long, k As Long, r As Long
      Dim ub1 As Long, ub2 As Long
      
      a = Range("A1").CurrentRegion.Value
      ub1 = UBound(a, 1)
      ub2 = UBound(a, 2)
      ReDim b(1 To ub1 * ub2, 1 To 3)
      b(1, 1) = "ID"
      b(1, 2) = "P"
      b(1, 3) = "Rank"
      k = 1
      For i = 2 To ub1
        r = 0
        For j = 2 To ub2
          If a(i, j) <> "" Then
            k = k + 1
            r = r + 1
            b(k, 1) = a(i, 1)
            b(k, 2) = a(i, j)
            b(k, 3) = IIf(j = 2, "First", r)
          End If
        Next j
        If r > 1 Then b(k, 3) = "Last"
      Next i
      Range("A1").Offset(, ub2 + 2).Resize(k, 3).Value = b
    End Sub
    Hope this helps, good luck.
    Peter
    Excel 365 - Windows 10
    - Want to help your helpers by posting a small, copyable, screen shot directly in your post? Look here
    - If posting vba code, please use Code Tags - like this [code]Paste code here[/code] - or use the # key in the Reply window
    - Read: Forum Rules, Forum Use Guidelines, & FAQ

  4. #4
    New Member
    Join Date
    Jun 2007
    Posts
    17
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Need Help for Rearranging Data with Macro or Formula

    Thank you very much Mick. Ray(c, 1) = Dn was highlighted in debug after I ran the macro. Does it require any special set up, like data should start with A1 etc? By the way I think I mislead by using P1, P2 etc as column headers. Actually there is no column header in the data. Thanks a lot.

  5. #5
    New Member
    Join Date
    Jun 2007
    Posts
    17
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Thumbs up Re: Need Help for Rearranging Data with Macro or Formula

    Thank you very much Peter. This is amazing. It works I thought it didnt work but I found the data in DS to DU columns. Could you also teach me what to change in macro to get this into a new sheet and for the others that are not "last" or "first", how to label as "middle" when needed. Thanks so much.

    Quote Originally Posted by Peter_SSs View Post
    My attempt:


    Sub Rearrange()
    **Dim a, b
    **Dim rws As Long, i As Long, j As Long, k As Long, r As Long
    **Dim ub1 As Long, ub2 As Long
    **
    **a = Range("A1").CurrentRegion.Value
    **ub1 = UBound(a, 1)
    **ub2 = UBound(a, 2)
    **ReDim b(1 To ub1 * ub2, 1 To 3)
    **b(1, 1) = "ID"
    **b(1, 2) = "P"
    **b(1, 3) = "Rank"
    **k = 1
    **For i = 2 To ub1
    ****r = 0
    ****For j = 2 To ub2
    ******If a(i, j) <> "" Then
    ********k = k + 1
    ********r = r + 1
    ********b(k, 1) = a(i, 1)
    ********b(k, 2) = a(i, j)
    ********b(k, 3) = IIf(j = 2, "First", r)
    ******End If
    ****Next j
    ****If r > 1 Then b(k, 3) = "Last"
    **Next i
    **Range("A1").Offset(, ub2 + 2).Resize(k, 3).Value = b
    End Sub
    Last edited by culyus; Nov 22nd, 2012 at 07:30 AM.

  6. #6
    MrExcel MVP
    Moderator
    Peter_SSs's Avatar
    Join Date
    May 2005
    Location
    Macksville, Australia
    Posts
    40,993
    Post Thanks / Like
    Mentioned
    90 Post(s)
    Tagged
    21 Thread(s)

    Default Re: Need Help for Rearranging Data with Macro or Formula

    Quote Originally Posted by culyus View Post
    Actually there is no column header in the data.
    In that case, for my code, change this line
    Code:
    For i = 1 To ub1
    Hope this helps, good luck.
    Peter
    Excel 365 - Windows 10
    - Want to help your helpers by posting a small, copyable, screen shot directly in your post? Look here
    - If posting vba code, please use Code Tags - like this [code]Paste code here[/code] - or use the # key in the Reply window
    - Read: Forum Rules, Forum Use Guidelines, & FAQ

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

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