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

CPAIT

New Member
Joined
Jan 29, 2015
Messages
3
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.


EXAMPLE DATA
BEFORE
Unique IDItem NameItem DescriptionNumbers SoldNotes
11111CupcakesRed10Good
11111CupcakesRed15Testing
11111CupcakesRed10Bad
22222BrowniesBrown11Example
22222BrowniesBrown11Example2
22222BrowniesBrown26Example3
AFTER
Unique IDItem NameItem DescriptionNumbers SoldNotes
11111CupcakesRed35Good, Testing, Bad
22222BrowniesBrown37Example, Example 2, Example 3

<tbody>
</tbody>

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!
 

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.
try, with your data beginning A1, running this


Code:
[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]
 
Upvote 0
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!

Code:
[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]
 
Upvote 0
you can try adding
Code:
application.screenupdating = false
as the first line of your code to see it it makes the macro run faster
 
Upvote 0
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.
 
Upvote 0
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!

Code:
[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]
 
Upvote 0
Upvote 0

Forum statistics

Threads
1,215,734
Messages
6,126,543
Members
449,316
Latest member
sravya

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top