Page 1 of 2 12 LastLast
Results 1 to 10 of 19

Thread: Merge Every 3 Rows into 1 row
Thanks Thanks: 0 Likes Likes: 0

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

    Default Merge Every 3 Rows into 1 row

    I have a data file of say 60,000 records and each record are up to column K. I need to combine every 3 rows as one row into a new worksheet.

    Input rows will be: A2 to K2, A3 to K3 and A4 to K4

    Output will be on a new worksheet will be from:
    A2 to AG2

    This formula will be for entire worksheet.

    There for the quantity in the output file will be 20,000 records.

  2. #2
    Board Regular kweaver's Avatar
    Join Date
    May 2018
    Location
    La Jolla, CA
    Posts
    629
    Post Thanks / Like
    Mentioned
    6 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Merge Every 3 Rows into 1 row

    Here's one way that seems to work:

    Code:
    Sub Copy3Rows()
    Dim LR As Long, i As Integer, j As Integer
    LR = Cells(Rows.Count, "G").End(xlUp).Row
    j = 2
    For i = 2 To LR Step 3
    Sheets("New").Range("A" & j, "K" & j).Value = Sheets("Original").Range("A" & i, "K" & i).Value
    Sheets("New").Range("L" & j, "V" & j).Value = Sheets("Original").Range("A" & i + 1, "K" & i + 1).Value
    Sheets("New").Range("W" & j, "AG" & j).Value = Sheets("Original").Range("A" & i + 2, "L" & i + 2).Value
    j = j + 1
    Next i
    End Sub

  3. #3
    New Member
    Join Date
    Mar 2018
    Posts
    17
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Merge Every 3 Rows into 1 row

    I got a Debug error

    For i = 2 To LR Step 3

    I just copied the code you have me. Don't know what I'm doing wrong.

  4. #4
    Board Regular kweaver's Avatar
    Join Date
    May 2018
    Location
    La Jolla, CA
    Posts
    629
    Post Thanks / Like
    Mentioned
    6 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Merge Every 3 Rows into 1 row

    Probably would get an error if the count from row 2 to N is not a multiple of 3.
    I didn't include any error checking to confirm that.
    Last edited by kweaver; Aug 2nd, 2019 at 04:36 PM.

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

    Default Re: Merge Every 3 Rows into 1 row

    Not every time the data will be evenly divided by 3. What if I have 7,000 records. The last row will have 1 record only. Can I use Offset formula to do it?

  6. #6
    Board Regular kweaver's Avatar
    Join Date
    May 2018
    Location
    La Jolla, CA
    Posts
    629
    Post Thanks / Like
    Mentioned
    6 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Merge Every 3 Rows into 1 row

    How about this adjustment?

    Code:
    Sub Copy3Rows()
    Dim LR As Long, i As Integer, j As Integer
    LR = Sheets("Original").Cells(Rows.Count, "G").End(xlUp).Row
    LR = LR + (1 + (LR - 2)) Mod 3
    j = 2
    For i = 2 To LR Step 3
    Sheets("New").Range("A" & j, "K" & j).Value = Sheets("Original").Range("A" & i, "K" & i).Value
    Sheets("New").Range("L" & j, "V" & j).Value = Sheets("Original").Range("A" & i + 1, "K" & i + 1).Value
    Sheets("New").Range("W" & j, "AG" & j).Value = Sheets("Original").Range("A" & i + 2, "L" & i + 2).Value
    j = j + 1
    Next i
    End Sub

  7. #7
    Board Regular kweaver's Avatar
    Join Date
    May 2018
    Location
    La Jolla, CA
    Posts
    629
    Post Thanks / Like
    Mentioned
    6 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Merge Every 3 Rows into 1 row

    I'm scratching my own head why I put "G" in this line. Change it to "A".

    LR = Sheets("Original").Cells(Rows.Count, "A").End(xlUp).Row

  8. #8
    New Member
    Join Date
    Mar 2018
    Posts
    17
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Merge Every 3 Rows into 1 row

    I get an error at "For i = 2 To LR Step 3"

  9. #9
    Board Regular
    Join Date
    Sep 2004
    Posts
    1,377
    Post Thanks / Like
    Mentioned
    9 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Merge Every 3 Rows into 1 row

    How long does this take?
    Change Sheet references as required.
    Code:
    Sub Maybe()
    Dim i As Long, j As Long
    i = 2
        For j = 2 To WorksheetFunction.RoundUp(Cells(Rows.Count, 1).End(xlUp).Row / 3, 0)
            With Sheets("Sheet3")
                .Cells(j, 1).Resize(, 11).Value = Cells(i, 1).Resize(, 11).Value
                .Cells(j, 12).Resize(, 11).Value = Cells(i + 1, 1).Resize(, 11).Value
                .Cells(j, 23).Resize(, 11).Value = Cells(i + 2, 1).Resize(, 11).Value
            End With
            i = i + 3
        Next j
    End Sub
    Last edited by jolivanes; Aug 3rd, 2019 at 12:07 AM.
    Theory is when you know something, but it doesnít work. Practice is when something works, but you donít know why. Politicians combine theory and practice: nothing works and they donít know why.

  10. #10
    Board Regular kweaver's Avatar
    Join Date
    May 2018
    Location
    La Jolla, CA
    Posts
    629
    Post Thanks / Like
    Mentioned
    6 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Merge Every 3 Rows into 1 row

    I'll need more info as I've tried this with 6000+ rows and it works. What error did you get? How many rows are there?

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
  •