locked
multiple range of data from rows into one row RRS feed

  • Question

  • Hi All,

    I tried to make multiple range of data from rows (column A) into one row (in column C) as shown in this link. Anyone can help me on this pls?

    https://excel.officeapps.live.com/x/_layouts/xlembedpreview.aspx?Fi=SDC13341F30B399775!145&H=emul&C=1__BL2-SKY-WAC-WSHI&ui=en-ID&rs=en-ID&su=-4525200688456034443&cy=4whoEgGCPXPgSYqr9wF0kceTw3vTFsZMiK8vfjCrDE0%3d4&ak=t%3d0%26s%3d0%26v%3d!ALHCkB_3K5H6RQE&ad=en-ID&hh=1&sc=host%3d&E=1&wdAllowInteractivity=False&wdDownloadButton=True&width=402&height=346

    Thanks in advance

    Monday, December 3, 2012 7:25 AM

Answers

  • I hadn't interpreted your original question that way. Here is a modified version:

    Sub Transform()
        Const FirstRow = 3
        Const SrcCol = 1
        Const TrgCol = 3
        Const Sep = "total"
        Dim LastRow As Long
        Dim SrcRow As Long
        Dim TrgRow As Long
        Dim NewVal As String
        TrgRow = FirstRow
        LastRow = Cells(Rows.Count, SrcCol).End(xlUp).Row
        For SrcRow = FirstRow To LastRow
            If Cells(SrcRow, SrcCol) = "total" Then
                If Left(NewVal, 4) = " RED" Then
                    Cells(TrgRow, TrgCol) = Trim(NewVal)
                    TrgRow = TrgRow + 1
                End If
                NewVal = ""
            Else
                NewVal = NewVal & " " & Cells(SrcRow, SrcCol)
            End If
        Next SrcRow
    End Sub


    Regards, Hans Vogelaar

    • Marked as answer by CRVR Tuesday, December 4, 2012 9:26 AM
    Tuesday, December 4, 2012 9:02 AM
  • Thanks!

    Try this modified version of the macro:

    Sub Transform()
        Const FirstRow = 3
        Const SrcCol = 1
        Const TrgCol = 4
        Const Sep = "total"
        Dim LastRow As Long
        Dim SrcRow As Long
        Dim TrgRow As Long
        Dim NewVal As String
        TrgRow = FirstRow
        LastRow = Cells(Rows.Count, SrcCol).End(xlUp).Row
        For SrcRow = FirstRow To LastRow
            If LCase(Cells(SrcRow, SrcCol)) Like "total*" Then
                If Left(NewVal, 4) = " RED" Then
                    Cells(TrgRow, TrgCol) = Trim(NewVal)
                    TrgRow = TrgRow + 1
                End If
                NewVal = ""
            Else
                NewVal = NewVal & " " & Cells(SrcRow, SrcCol)
            End If
        Next SrcRow
    End Sub


    Regards, Hans Vogelaar

    • Marked as answer by CRVR Wednesday, December 12, 2012 1:11 AM
    Wednesday, December 12, 2012 12:12 AM
  • Ah, I see. Try this version:

    Sub Transform()
        Const FirstRow = 3
        Const SrcCol = 1
        Const TrgCol = 4
        Const Sep = "total"
        Dim LastRow As Long
        Dim SrcRow As Long
        Dim TrgRow As Long
        Dim NewVal As String
        TrgRow = FirstRow
        LastRow = Cells(Rows.Count, SrcCol).End(xlUp).Row
        For SrcRow = FirstRow To LastRow
            If LCase(Cells(SrcRow, SrcCol)) Like "total*" Then
                If Left(NewVal, 4) = " RED" Then
                    Cells(TrgRow, TrgCol) = Trim(NewVal)
                    TrgRow = TrgRow + 1
                End If
                NewVal = ""
            ElseIf Left(Cells(SrcRow, SrcCol), 3) = "RED" Then
                NewVal = " " & Cells(SrcRow, SrcCol)
            Else
                NewVal = NewVal & " " & Cells(SrcRow, SrcCol)
            End If
        Next SrcRow
    End Sub


    Regards, Hans Vogelaar

    • Marked as answer by CRVR Tuesday, December 18, 2012 7:59 AM
    Monday, December 17, 2012 9:21 AM

All replies

  • Try this macro:

    Sub Transform()
        Const FirstRow = 3
        Const SrcCol = 1
        Const TrgCol = 3
        Const Sep = "total"
        Dim LastRow As Long
        Dim SrcRow As Long
        Dim TrgRow As Long
        Dim NewVal As String
        TrgRow = FirstRow
        LastRow = Cells(Rows.Count, SrcCol).End(xlUp).Row
        For SrcRow = FirstRow To LastRow
            If Cells(SrcRow, SrcCol) = "total" Then
                Cells(TrgRow, TrgCol) = Trim(NewVal)
                NewVal = ""
                TrgRow = TrgRow + 1
            Else
                NewVal = NewVal & " " & Cells(SrcRow, SrcCol)
            End If
        Next SrcRow
    End Sub

    You can change the constants at the beginning as needed.

    Regards, Hans Vogelaar

    Monday, December 3, 2012 8:41 AM
  • Thank you Hans, but I still have the grey and black in the column.

    How to get rid of them and leave only the red instead?

    Thanks again.

    Tuesday, December 4, 2012 8:45 AM
  • I hadn't interpreted your original question that way. Here is a modified version:

    Sub Transform()
        Const FirstRow = 3
        Const SrcCol = 1
        Const TrgCol = 3
        Const Sep = "total"
        Dim LastRow As Long
        Dim SrcRow As Long
        Dim TrgRow As Long
        Dim NewVal As String
        TrgRow = FirstRow
        LastRow = Cells(Rows.Count, SrcCol).End(xlUp).Row
        For SrcRow = FirstRow To LastRow
            If Cells(SrcRow, SrcCol) = "total" Then
                If Left(NewVal, 4) = " RED" Then
                    Cells(TrgRow, TrgCol) = Trim(NewVal)
                    TrgRow = TrgRow + 1
                End If
                NewVal = ""
            Else
                NewVal = NewVal & " " & Cells(SrcRow, SrcCol)
            End If
        Next SrcRow
    End Sub


    Regards, Hans Vogelaar

    • Marked as answer by CRVR Tuesday, December 4, 2012 9:26 AM
    Tuesday, December 4, 2012 9:02 AM
  • It worked very well Hans. Brilliant! and I only waited for not more than one minute!

    Thank you!
    Tuesday, December 4, 2012 9:26 AM
  • Hello again Hans,

    How if I have another variable in the cell contained "total". For instance, total1, total2, and etc.

    How do I create a unique variable for all which contain total or so.

    Thanks again

    Tuesday, December 11, 2012 8:14 AM
  • Can you provide an example?

    Regards, Hans Vogelaar

    Tuesday, December 11, 2012 8:57 AM
  • Here is the example:

    https://excel.officeapps.live.com/x/_layouts/xlembedpreview.aspx?Fi=SDC13341F30B399775!149&H=emul&C=1__BL2-SKY-WAC-WSHI&ui=en-ID&rs=en-ID&su=-4525200688456034443&cy=SCO4aW2SloXqzu1pjbrA5%2fsKFJccls%2fYUA2ZVGxrlhk%3d6&ak=t%3d0%26s%3d0%26v%3d!AEdu16ZCLF9r2GA&ad=en-ID&hh=1&sc=host%3d&E=1&wdAllowInteractivity=False&width=402&height=346

    Thanks!

    Wednesday, December 12, 2012 12:05 AM
  • Thanks!

    Try this modified version of the macro:

    Sub Transform()
        Const FirstRow = 3
        Const SrcCol = 1
        Const TrgCol = 4
        Const Sep = "total"
        Dim LastRow As Long
        Dim SrcRow As Long
        Dim TrgRow As Long
        Dim NewVal As String
        TrgRow = FirstRow
        LastRow = Cells(Rows.Count, SrcCol).End(xlUp).Row
        For SrcRow = FirstRow To LastRow
            If LCase(Cells(SrcRow, SrcCol)) Like "total*" Then
                If Left(NewVal, 4) = " RED" Then
                    Cells(TrgRow, TrgCol) = Trim(NewVal)
                    TrgRow = TrgRow + 1
                End If
                NewVal = ""
            Else
                NewVal = NewVal & " " & Cells(SrcRow, SrcCol)
            End If
        Next SrcRow
    End Sub


    Regards, Hans Vogelaar

    • Marked as answer by CRVR Wednesday, December 12, 2012 1:11 AM
    Wednesday, December 12, 2012 12:12 AM
  • It worked! Thanks a lot!
    Wednesday, December 12, 2012 1:11 AM
  • I found some empty rows after "total" and the code could not continue. Is there anyway to do this? Thanks again
    • Edited by CRVR Monday, December 17, 2012 1:59 AM
    Monday, December 17, 2012 1:59 AM
  • What do you mean by "the code could not continue"?

    Regards, Hans Vogelaar

    Monday, December 17, 2012 8:16 AM
  • It did not go through the rest of the data. Here is the example:

    https://excel.officeapps.live.com/x/_layouts/xlembedpreview.aspx?Fi=SDC13341F30B399775!149&H=emul&C=1__BL2-SKY-WAC-WSHI&ui=en-ID&rs=en-ID&su=-4525200688456034443&cy=6xSP6QbiSr4jUEBGMFNl49XyvMH1nxhL2xV8iczYR7Q%3d6&ak=t%3d0%26s%3d0%26v%3d!AEdu16ZCLF9r2GA&ad=en-ID&hh=1&sc=host%3d&E=1&wdAllowInteractivity=False&width=402&height=346

    Many thanks

    Monday, December 17, 2012 8:49 AM
  • Ah, I see. Try this version:

    Sub Transform()
        Const FirstRow = 3
        Const SrcCol = 1
        Const TrgCol = 4
        Const Sep = "total"
        Dim LastRow As Long
        Dim SrcRow As Long
        Dim TrgRow As Long
        Dim NewVal As String
        TrgRow = FirstRow
        LastRow = Cells(Rows.Count, SrcCol).End(xlUp).Row
        For SrcRow = FirstRow To LastRow
            If LCase(Cells(SrcRow, SrcCol)) Like "total*" Then
                If Left(NewVal, 4) = " RED" Then
                    Cells(TrgRow, TrgCol) = Trim(NewVal)
                    TrgRow = TrgRow + 1
                End If
                NewVal = ""
            ElseIf Left(Cells(SrcRow, SrcCol), 3) = "RED" Then
                NewVal = " " & Cells(SrcRow, SrcCol)
            Else
                NewVal = NewVal & " " & Cells(SrcRow, SrcCol)
            End If
        Next SrcRow
    End Sub


    Regards, Hans Vogelaar

    • Marked as answer by CRVR Tuesday, December 18, 2012 7:59 AM
    Monday, December 17, 2012 9:21 AM
  • This is perfect! Thank you very much!
    Tuesday, December 18, 2012 8:00 AM