Excel VBA Macro - Merging Rows on a Unique Identifier while Keeping Unique Data and Adding Values Together

[CPAIT]

I have a large excel spreadsheet where I need to merge rows on a unique identifier. I'm trying to develop an Excel VBA macro but still lack the proficiency to tackle this.

Here is a picture of an example of what I'm trying to do. The data including the headers are all made up for the example but what is demonstrated down below is exactly what I'm trying to do.

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]EXAMPLE DATA[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]BEFORE[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Unique ID[/TD]
[TD]Item Name[/TD]
[TD]Item Description[/TD]
[TD]Numbers Sold[/TD]
[TD]Notes[/TD]
[/TR]
[TR]
[TD]11111[/TD]
[TD]Cupcakes[/TD]
[TD]Red[/TD]
[TD]10[/TD]
[TD]Good[/TD]
[/TR]
[TR]
[TD]11111[/TD]
[TD]Cupcakes[/TD]
[TD]Red[/TD]
[TD]15[/TD]
[TD]Testing[/TD]
[/TR]
[TR]
[TD]11111[/TD]
[TD]Cupcakes[/TD]
[TD]Red[/TD]
[TD]10[/TD]
[TD]Bad[/TD]
[/TR]
[TR]
[TD]22222[/TD]
[TD]Brownies[/TD]
[TD]Brown[/TD]
[TD]11[/TD]
[TD]Example[/TD]
[/TR]
[TR]
[TD]22222[/TD]
[TD]Brownies[/TD]
[TD]Brown[/TD]
[TD]11[/TD]
[TD]Example2[/TD]
[/TR]
[TR]
[TD]22222[/TD]
[TD]Brownies[/TD]
[TD]Brown[/TD]
[TD]26[/TD]
[TD]Example3[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]AFTER[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Unique ID[/TD]
[TD]Item Name[/TD]
[TD]Item Description[/TD]
[TD]Numbers Sold[/TD]
[TD]Notes[/TD]
[/TR]
[TR]
[TD]11111[/TD]
[TD]Cupcakes[/TD]
[TD]Red[/TD]
[TD]35[/TD]
[TD]Good, Testing, Bad[/TD]
[/TR]
[TR]
[TD]22222[/TD]
[TD]Brownies[/TD]
[TD]Brown[/TD]
[TD]37[/TD]
[TD]Example, Example 2, Example 3[/TD]
[/TR]
</tbody>[/TABLE]

As you can see, similar data is merged together on the first 3 columns based upon the unique ID. The 4th column containing number values are added up. Any unique values in the 5th column are kept together as unique data.

I would appreciate any help or tips anyone can give me. Thank you!

 

[VBA Geek]

try, with your data beginning A1, running this

[color=darkblue]Sub[/color] merger()
[color=darkblue]Dim[/color] lRow1 [color=darkblue]As[/color] [color=darkblue]Long[/color], lRow2 [color=darkblue]As[/color] [color=darkblue]Long[/color]


Range("A1").CurrentRegion.Resize(, 3).AdvancedFilter xlFilterCopy, , Range("h1"), [color=darkblue]True[/color]


Range("K1:l1").Value = Range("d1:e1").Value


lRow1 = Range("A" & Rows.Count).End(xlUp).Row
lRow2 = Range("H" & Rows.Count).End(xlUp).Row


Range("k2:k" & lRow2).Formula = Replace$("=SUMIFS(D$2:D$@,A$2:A$@,H2,B$2:B$@,I2,C$2:C$@,J2)", "@", lRow1)
Range("l2:l" & lRow2).Formula = Replace$("=ConcatMatches(E$2:E$@,A$2:A$@,H2,B$2:B$@,I2,C$2:C$@,J2)", "@", lRow1)
[color=darkblue]End[/color] [color=darkblue]Sub[/color]


[color=darkblue]Function[/color] ConcatMatches(RngResult [color=darkblue]As[/color] Range, Rng1 [color=darkblue]As[/color] Range, Cond1 [color=darkblue]As[/color] [color=darkblue]Variant[/color], _
                        Rng2 [color=darkblue]As[/color] Range, Cond2 [color=darkblue]As[/color] [color=darkblue]Variant[/color], _
                        Rng3 [color=darkblue]As[/color] Range, Cond3 [color=darkblue]As[/color] [color=darkblue]Variant[/color]) [color=darkblue]As[/color] [color=darkblue]String[/color]
                      
[color=darkblue]Dim[/color] x1 [color=darkblue]As[/color] [color=darkblue]Long[/color], S [color=darkblue]As[/color] [color=darkblue]String[/color]


[color=darkblue]For[/color] x1 = 1 [color=darkblue]To[/color] RngResult.Cells.Count
    [color=darkblue]If[/color] Rng1(x1, 1).Value = Cond1 [color=darkblue]Then[/color]
        [color=darkblue]If[/color] Rng2(x1, 1).Value = Cond2 [color=darkblue]Then[/color]
            [color=darkblue]If[/color] Rng3(x1, 1).Value = Cond3 [color=darkblue]Then[/color]
                S = S & RngResult(x1, 1).Value & ", "
            [color=darkblue]End[/color] [color=darkblue]If[/color]
        [color=darkblue]End[/color] [color=darkblue]If[/color]
    [color=darkblue]End[/color] [color=darkblue]If[/color]
[color=darkblue]Next[/color] x1


[color=darkblue]If[/color] Len(S) [color=darkblue]Then[/color] S = Left(S, Len(S) - 2)
ConcatMatches = S
[color=darkblue]End[/color] [color=darkblue]Function[/color]

 

[CPAIT]

Thanks VPA Geek! I appreciate the response.

it worked perfectly, though it does take a bit of time for the macro to finish executing.

I'm going through the code to see what you did and why, though I'm not exactly how your replacement formulas for the SUMIF and custom function ConcatMatches work exactly. I understand that arguments 1 and 2 for both of them are for the range and criteria but I'm not sure what the other parts of them are for exactly. Likewise for the nesting IF statements you created for the custom function ConcatMatches. I'm also curious why you used the @ in E$2:E$@ for example. Is the @ supposed to be a placeholder to allow you to do an absolute reference or is it for something else?

If you have the time, I would appreciate it if you could elaborate a bit about why you did what you did. I annotated parts of the code below for what I think some parts of the code are for, but my knowledge is at the level of a novice and is lacking.

Thank you again!

[B]Sub Dearborn_Report_Macro()[/B]
[B]Dim lRow1 As Long, lRow2 As Long[/B]
'Dim statement to specify variables data types to speed up execution and memory use


[B]Range("A1").CurrentRegion.Resize(, 3).AdvancedFilter xlFilterCopy, , Range("h1"), True[/B]
'Selects Cell A1 and uses the current region and resize properties to select column A and then expand the selection to include columns B & C.
'Then the AdvancedFilter copy method is used to transpose the selected data to Cell H1.


[B]Range("K1:l1").Value = Range("d1:e1").Value[/B]
'Columns K and L are set to have data equivlanet to Columns D and E


[B]lRow1 = Range("A" & Rows.Count).End(xlUp).Row
lRow2 = Range("H" & Rows.Count).End(xlUp).Row[/B]
'Specifies the variables as the unique identifier from the first column A where Rows A and H are selected


[B]Range("k2:k" & lRow2).Formula = Replace$("=SUMIFS(D$2:D$@,A$2:A$@,H2,B$2:B$@,I2,C$2:C$@,J2)", "@", lRow1)[/B]
'Selects the unique identifier specified in Column H as well as the range from cell K2 and rest of the K column. The replace function is then used to insert the data.
'The SUMIFS formula is used to specify the D column (absolutely referenced) as the range to sum, Column A (absolutely referenced) as the criteria to match, Columns B & C are matched to their corresponding I & J value.

[B]Range("l2:l" & lRow2).Formula = Replace$("=ConcatMatches(E$2:E$@,A$2:A$@,H2,B$2:B$@,I2,C$2:C$@,J2)", "@", lRow1)[/B]
'Custom Function used to keep the unique data values of Column E as they are replaced to the L column.

End Sub


[B]Function ConcatMatches(RngResult As Range, Rng1 As Range, Cond1 As Variant, _
                        Rng2 As Range, Cond2 As Variant, _
                        Rng3 As Range, Cond3 As Variant) As String[/B]


[B]Dim x1 As Long, S As String[/B]
'Specifies varaible data types
[B]

For x1 = 1 To RngResult.Cells.Count
    If Rng1(x1, 1).Value = Cond1 Then
        If Rng2(x1, 1).Value = Cond2 Then
            If Rng3(x1, 1).Value = Cond3 Then
                S = S & RngResult(x1, 1).Value & ", "
            End If
        End If
    End If
Next x1[/B]
'Nesting IF statements to check data and return it on condition


[B]If Len(S) Then S = Left(S, Len(S) - 2)
ConcatMatches = S
End Function[/B]

 

[robert4136]

you can try adding

application.screenupdating = false

as the first line of your code to see it it makes the macro run faster

 

[VBA Geek]

hello

though it does take a bit of time for the macro to finish executing

if it takes too long it can be edit to work with arrays other than always referring to the range

Is the @ supposed to be a placeholder to allow you to do an absolute reference or is it for something else?

The @ will be modified by the REPLACE function which will make it equal to the last row of your data

for isntance if D2:D@ and lRow1 is 50, the replace will turn D2:D@ into D2:D50.

 

[CPAIT]

hello

If it takes too long it can be edit to work with arrays other than always referring to the range

The @ will be modified by the REPLACE function which will make it equal to the last row of your data

for instance if D2:D@ and lRow1 is 50, the replace will turn D2:D@ into D2:D50.

I see, that makes sense.

The final question I have is if you have any sources you would recommend to become more proficient in things like the below code you wrote. I also have access to Microsoft Excel for Dummies and John Walkenbach's Excel Power Programming 2010 and 2013 versions. What resources do you sugget Or out of the books I mentioned, what particular sections do you suggest for reading?

Thanks!

[B]Function ConcatMatches(RngResult As Range, Rng1 As Range, Cond1 As Variant, _
                        Rng2 As Range, Cond2 As Variant, _
                        Rng3 As Range, Cond3 As Variant) As String[/B]


[B]Dim x1 As Long, S As String[/B]
'Specifies varaible data types
[B]

For x1 = 1 To RngResult.Cells.Count
    If Rng1(x1, 1).Value = Cond1 Then
        If Rng2(x1, 1).Value = Cond2 Then
            If Rng3(x1, 1).Value = Cond3 Then
                S = S & RngResult(x1, 1).Value & ", "
            End If
        End If
    End If
Next x1[/B]
'Nesting IF statements to check data and return it on condition


[B]If Len(S) Then S = Left(S, Len(S) - 2)
ConcatMatches = S
End Function[/B]

 

[VBA Geek]

after you're done with John's book and you have a better grasp, you can check out these

http://www.amazon.com/Professional-Excel-Development-Definitive-Applications/dp/0321508793
VBA Developer's Handbook, 2nd Edition: Ken Getz, Mike Gilbert: 0025211229781: Amazon.com: Books

also Mr Excel store has very good books: The MrExcel Store - Welcome to The MrExcel Store

then a lot of practice and try to answer questions on this forum