Thanks Thanks:  0
Likes Likes:  0
Page 3 of 3 FirstFirst 123
Results 21 to 28 of 28

Thread: Merge duplicate rows into one row

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

    Default Re: Merge duplicate rows into one row

    markmzz you are a genius! I tried your V2 code without expecting much luck. For one thing the macros I find online never work because I use Excel Mac. I copied it in, ran it and yours worked perfectly first time! It has saved me many hours, probably an entire days work. You are amazing, thank you.

  2. #22
    New Member
    Join Date
    Aug 2014
    Posts
    2
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Merge duplicate rows into one row

    Markmzz,

    Can you help me?

    Similar issue. Multilple rows with the same name (specific person) in column 2. In column H is a different identifier of an insurance coverage that person has. Colum I,J and K all tie to H. Can you help me combine the multiple rows into one row?
    Is th is possible?

  3. #23
    New Member
    Join Date
    Aug 2014
    Posts
    2
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Merge duplicate rows into one row

    Quote Originally Posted by helpneededinhouston View Post
    Markmzz,

    Can you help me?

    Similar issue. Multilple rows with the same name (specific person) in column 2. In column H is a different identifier of an insurance coverage that person has. Colum I,J and K all tie to H. Can you help me combine the multiple rows into one row?
    Is th is possible?


    here is the link to the image of my spreadsheet

    http://postimg.org/image/bffezwrlv/
    Last edited by helpneededinhouston; Aug 2nd, 2014 at 01:24 PM. Reason: image fail

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

    Default Re: Merge duplicate rows into one row

    Did you check the code in the first and second pages of this thread
    Copy and paste this into columns A,B and C in Sheet1

    James 123 aaa
    Billy 6574 bbbb
    James 234 bbb
    James 1484 ddd
    Milly 231 nnn
    Milly 233 hh

    Right click on the sheet1 tab and choose View Code Then Copy the Code From the previous page and pasted there click the green button (RUN) go to sheet1 and see if that's the result you want.

  5. #25
    MrExcel MVP
    Join Date
    May 2011
    Posts
    3,699
    Post Thanks / Like
    Mentioned
    5 Post(s)
    Tagged
    1 Thread(s)

    Default Re: Merge duplicate rows into one row

    Quote Originally Posted by helpneededinhouston View Post
    Markmzz,

    Can you help me?

    Similar issue. Multilple rows with the same name (specific person) in column 2. In column H is a different identifier of an insurance coverage that person has. Colum I,J and K all tie to H. Can you help me combine the multiple rows into one row?
    Is th is possible?
    Helpneededinhouston,

    Look at your PM Box.

    Markmzz

  6. #26
    New Member
    Join Date
    Jun 2004
    Posts
    20
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Merge duplicate rows into one row

    Quote Originally Posted by markmzz View Post
    Helpneededinhouston,

    Look at your PM Box.

    Markmzz
    Did you check the code in the first and second pages of this thread
    Copy and paste this into columns A,B and C in Sheet1

    James 123 aaa
    Billy 6574 bbbb
    James 234 bbb
    James 1484 ddd
    Milly 231 nnn
    Milly 233 hh

    Right click on the sheet1 tab and choose View Code Then Copy the Code From the previous page and pasted there click the green button (RUN) go to sheet1 and see if that's the result you want.

  7. #27
    New Member
    Join Date
    May 2015
    Posts
    1
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Merge duplicate rows into one row

    Hi,

    The solution is really great.

    I have three issues now.

    1.The speed of the execution of the macro is too slow.(Have more than 30,000 rows)
    2.Merging of the rows I want it in a new sheet rather than on the same sheet.
    3.How do I ensure the headers do not repeat rather renamed with a sequel like:

    As-is:ID Part Status

    To-be:ID Part_1 Status_1 Part_2 Status_2 ,so on.....

    Can someone help me on this?



    Quote Originally Posted by markmzz View Post
    Sudex,

    I believe that I resolved the problem.

    What happened was that the count of columns from the second list was being made incorrectly. I was using the current region, but its data has several empty cells and therefore was causing the error.

    Test the code below calmly and give us a feedback.

    Obs: I send to you a email.

    Code:
    Sub NamesData_v2()
    '
    'Prg    : NamesData_v2
    'Author : Markmzz
    'Date   : 25/05/2011
    'Version: 02
    '
        'Explicitly defines the variables
        Dim LastRowL1, LastRowL2, LastColL1, NextCol As Long
        Dim RL1, RL2, CL1, CL2, NCL1, NCL2, CCL2, LCL2 As Long
        Dim NameList2 As String
     
        'Disable screen updating
        Application.ScreenUpdating = False
     
        'Determines the number of rows of the first list
        LastRowL1 = Cells(Rows.Count, 1).End(xlUp).Row
     
        'Determines the number of columns of the first list
        LastColL1 = Cells(1, Columns.Count).End(xlToLeft).Column
     
        'Determines the number of columns with
        'Name column out of the first list
        NCL1 = LastColL1 - 1
     
        'Sort, in ascending order, the 1st list
        Range(Cells(2, 1), Cells(LastRowL1, LastColL1)).Sort _
            Key1:=Range("A1"), _
            Order1:=xlAscending
     
        'Initial Column of the 2nd list
        NextCol = LastColL1 + 2
     
        'Create one sort list of unique names (list 2)
        Range(Cells(1, 1), Cells(LastRowL1, 1)).AdvancedFilter _
            Action:=xlFilterCopy, _
            CopyToRange:=Range(Cells(1, NextCol).Address), _
            Unique:=True
        Cells(1, NextCol).Font.Bold = False
     
        'Determines the number of rows from the second list
        LastRowL2 = Cells(Rows.Count, NextCol).End(xlUp).Row
     
        'Define two with the current Row in the 1st list
        RL1 = 2
     
        'Navigate by Names of the 2nd list
        For RL2 = 2 To LastRowL2
            'Show the progress in the Status Bar of the Excel
            Application.StatusBar = "Processing row " & RL2 & " of " & LastRowL2
            'Store the current Name of the 2nd list
            NameList2 = Cells(RL2, NextCol).Value
     
            'Define NextCol+1 with the current Column in the 2nd list
            CL2 = NextCol + 1
     
            'Navigate by Names in the 1st list that are equal
            'the current Name in the 2nd lists
            Do While Cells(RL1, 1) = NameList2
                'Fill, in the 2nd list, the data of the current name
                For CL1 = 2 To LastColL1
                    Cells(RL2, CL2).Value = Cells(RL1, CL1).Value
                    'Add one to the counter of the current Column in the 2st list
                    CL2 = CL2 + 1
                Next CL1
     
                'New *********************************************************** New
                'New *********************************************************** New
                'Determines the last column of the 2nd list
                If LCL2 < CL2 Then
                    LCL2 = CL2
                End If
                'Add one to the counter of the current Row in the 1st list
                RL1 = RL1 + 1
            Loop
        Next RL2
     
        'New ***************************************************************** New
        'New ***************************************************************** New
        'Determines the number of columns in group (Col2, Col3,...) in 2nd List
        NCL2 = (LCL2 - NextCol - 1) / NCL1
     
        'Fill the labels of columns of 2nd List
        For CCL2 = 1 To NCL2
            For CL1 = 2 To LastColL1
                Cells(1, (CCL2 - 1) * NCL1 + NextCol + CL1 - 1).Value = _
                    Cells(1, CL1).Value
            Next CL1
        Next CCL2
     
        'Autofit the columns of 2nd List
        Cells(1, NextCol).CurrentRegion.EntireColumn.AutoFit
     
        'Enable screen updating
        Application.ScreenUpdating = True
     
        'Reset the Status Bar of the Excel
        Application.StatusBar = False
    End Sub
    Markmzz

  8. #28
    MrExcel MVP
    Join Date
    May 2011
    Posts
    3,699
    Post Thanks / Like
    Mentioned
    5 Post(s)
    Tagged
    1 Thread(s)

    Default Re: Merge duplicate rows into one row

    Hello!

    Here is a new version of the macro (v4).

    Code:
    Sub NamesData_v4()
    '
    'Prg    : NamesData_v4
    'Author : Markmzz
    'Date   : 07/10/2017
    'Version: 04
    '
        'Define the variables explicitly
        Dim LastRowL1 As Long, LastRowL2 As Long, LastColL1 As Long
        Dim FirstColL2 As Long, RL1 As Long, RL2 As Long, CL1 As Long, CL2 As Long
        Dim NCDL1 As Long, NCDL2 As Long, CGCDL2 As Long, LCL2 As Long, NGCDL2 As Long
        Dim CurrentNameL2 As String
        Dim myNewSheet As Worksheet, mySheet As Worksheet
        Dim myArrayL1 As Variant, myArrayL2 As Variant
    
        'Disable screen updating and activate the Data worksheet
        Application.ScreenUpdating = False
        Set mySheet = Worksheets("Data")
        mySheet.Activate
     
        'Determine the number of rows in the first list
        LastRowL1 = Cells(Rows.Count, 1).End(xlUp).Row
     
        'Determine the number of columns in the first list
        LastColL1 = Cells(1, Columns.Count).End(xlToLeft).Column
     
        'Determine the number of columns without the Name column in the first list
        NCDL1 = LastColL1 - 1
     
        'Sort, in ascending order, the first list
        Range(Cells(2, 1), Cells(LastRowL1, LastColL1)).Sort _
            Key1:=Range("A1"), _
            Order1:=xlAscending
        
        'Fill the first list array
        myArrayL1 = Range(Cells(1, 1), Cells(LastRowL1, LastColL1))
     
        'Set the first column of the second list
        FirstColL2 = 1
     
        'Create a new worksheet
        Set myNewSheet = Sheets.Add
        
        'Give the name of MergeData to the new worksheet
        'If exist MergeData worksheet, delete it
        On Error Resume Next
        Application.DisplayAlerts = False
        Worksheets("MergeData").Delete
        Application.DisplayAlerts = True
        On Error GoTo 0
        myNewSheet.Name = "MergeData"
        
        'Create one sort list of unique names in the new worksheet (MergeData - list 2)
        mySheet.Activate
        Range(Cells(1, 1), Cells(LastRowL1, 1)).AdvancedFilter _
            Action:=xlFilterCopy, _
            CopyToRange:=myNewSheet.Range(Cells(1, 1).Address), _
            Unique:=True
     
        'Activate the worksheet MergeData
        myNewSheet.Activate
        
        'Determine the number of rows in the second list (MergeData worksheet)
        LastRowL2 = Cells(Rows.Count, FirstColL2).End(xlUp).Row
     
        'Determine the number of columns in the second list (without column Name)
        ActiveSheet.Cells(1, 3).FormulaArray = _
            "=Large(Countif(Data!$A$2:$A$" & LastRowL1 & "," & _
            Range(Cells(1, FirstColL2), Cells(LastRowL2, FirstColL2)).Address & "),1)"
        NCDL2 = (LastColL1 - 1) * Cells(1, 3).Value
        ActiveSheet.Cells(1, 3).Clear
        
        'Fill the second list array
        myArrayL2 = Range(Cells(1, 1), Cells(LastRowL2, NCDL2 + 1)).Value
        Range(Cells(1, 1), Cells(LastRowL2, NCDL2 + 1)).Clear
        
        'Set one as the last column in the second list
        LCL2 = 1
        
        'Set two as the the current row in the first list
        RL1 = 2
        
        'Navigate by Names of the second list
        For RL2 = 2 To LastRowL2
            'Store the current Name of the second list
            CurrentNameL2 = myArrayL2(RL2, FirstColL2)
        
            'Define FirstColL2+1 with the current column in the second list
            CL2 = FirstColL2 + 1
            
            'Navigate by Names in the first list that are equal
            'the current Name in the second list
            Do While myArrayL1(RL1, 1) = CurrentNameL2
                'Fill, in the second list, the data of the current name
                For CL1 = 2 To LastColL1
                    myArrayL2(RL2, CL2) = myArrayL1(RL1, CL1)
                    'Add one to the counter of the current column in the second list
                    CL2 = CL2 + 1
                Next CL1
                
                'Add one to the counter of the current row in the first list
                RL1 = RL1 + 1
                
                'If the counter of the current row in the first list
                'is greater than the total of rows in the first list, exit do
                If RL1 > LastRowL1 Then Exit Do
            Loop
        Next RL2
     
        'Determine the number of columns in group (Col2, Col3,...) in second List
        NGCDL2 = NCDL2 / NCDL1
     
        'Fill the data of the second list
        Range(Cells(1, 1), Cells(LastRowL2, NCDL2 + 1)).Value = myArrayL2
            
        'Fill the labels of columns of the second list
        For CGCDL2 = 1 To NGCDL2
            For CL1 = 2 To LastColL1
                Cells(1, (CGCDL2 - 1) * NCDL1 + CL1).Value = _
                    myArrayL1(1, CL1) & "_" & CGCDL2
            Next CL1
        Next CGCDL2
         
        'Autofit the columns of the second List
        Cells(1, FirstColL2).CurrentRegion.EntireColumn.AutoFit
        
        'Enable screen updating
        Application.ScreenUpdating = True
    End Sub
    Do some tests.

    Markmzz

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
  •