VBA code to merge duplicate rows and keep non-null values?

Question

I'm looking for a more efficient way of merging duplicate rows depending on the column name "Product." Some rows will not have duplicates. Here is a sample of the data I'm working with. In reality, I am working with thousands of these rows and over 40 columns. If it is determined that a duplicate row exists based on the column "Product", my goal is to merge into one row and keep the non-null values.

Here is a link to my post in mr. excel but no one could figure out a solution: https://www.mrexcel.com/forum/excel-questions/1014177-how-combine-rows-duplicate-info-into-one-based-column.html

Here's an image of the before and after"

image of before and after

Any ideas on how I could make this process more efficient? I would think VBA code is required I am currently doing this manually and it is very painful. Thank you!

qz_99 · Accepted Answer · 2017-07-14 17:46:53Z

0

Sub compareLines()

'Set selected cell to starting position Row 2 Column A
ActiveSheet.Cells(2, 1).Select

'Stopping the application updating the screen while the macro is running which can significantly increase the speed of vba 
Application.ScreenUpdating = False

'Loop to keep macro running into it reaches the last 'Product'
While ActiveCell.Value <> ""

    'Check whether the product name in the next row is the same as the product in the current row    
    If ActiveCell.Value = ActiveCell.Offset(1, 0).Value Then

        'Keep going until you reach the 40th column(change this to what u need)
        For i = 2 To 40

        'Checks whether the next column is blank
        If ActiveCell.Offset(0, i).Value = "" Then

            'If the column is in fact blank then copy the value of the row below
            ActiveCell.Offset(0, i).Value = ActiveCell.Offset(1, i).Value

        End If
        'move to next column
        Next

    'Once the last column has been reached, delete the duplicate row
    ActiveCell.Offset(1, 0).EntireRow.Delete

    'If product below isn't the same as the current product
    Else

    'Then move to the next row
    ActiveCell.Offset(1, 0).Select

    End If

Wend

'turning this back on so you can see the changes
Application.ScreenUpdating = True

End Sub

Change the 'For' statement to how many columns you have :)

edited Jul 14, 2017 at 17:46

answered Jul 14, 2017 at 15:13

qz_99

1751 silver badge13 bronze badges

Sign up to request clarification or add additional context in comments.

1 Comment

astro45 Over a year ago

Hello Kieran, This works for me, but do you mind explaining what each line does. I'm a beginner to VBA.

E. Trofimov · Accepted Answer · 2017-07-14 15:00:35Z

0

May be something like this:

dim rRange as Range
Set rRange = Application.InputBox('', '' , Type:=8)

Don't remember exactly..

answered Jul 14, 2017 at 15:00

E. Trofimov

922 silver badges11 bronze badges

Collectives™ on Stack Overflow

VBA code to merge duplicate rows and keep non-null values?

2 Answers 2

1 Comment

Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

1 Comment

Comments

Your Answer

Sign up or log in

Post as a guest

Related