VBA to consolidate and sum values

DDePoy

New Member
Joined
Jan 8, 2017
Messages
9
Hello,

I recorded a Macro using the Consolidation tool however when I run the Macro, it does not complete the task.

Here is what it looks like:

Sub Consolidate()
'
' Consolidate Macro
'


'
Sheets("Inventory Value Report").Select
Range("D1").Select
Selection.Consolidate Sources:=Array( _
"'C:\Users\ddep9969\AppData\Local\Microsoft\Windows\INetCache\Content.Outlook\U7MD7TOU\[Inventory Value Report 06062019 (002).xls]Inventory Value Report'!R1C1:R914C2" _
, _
"'C:\Users\ddep9969\AppData\Local\Microsoft\Windows\INetCache\Content.Outlook\U7MD7TOU\[Inventory Value Report 06062019 (002).xls]Inventory Value Report'!R1C1:R1200C2" _
), Function:=xlSum, TopRow:=True, LeftColumn:=True, CreateLinks:=False
End Sub

Can someone help me with creating a Module that locates the duplicates in column A and sums the values in column B:

[TABLE="width: 294"]
<colgroup><col span="2"></colgroup><tbody>[TR]
[TD]Item Number[/TD]
[TD]Quantity on Hand[/TD]
[/TR]
[TR]
[TD]3029891[/TD]
[TD="align: right"]1[/TD]
[/TR]
[TR]
[TD]5101078[/TD]
[TD="align: right"]1.08[/TD]
[/TR]
[TR]
[TD]7002294[/TD]
[TD="align: right"]0.5[/TD]
[/TR]
[TR]
[TD]7002294[/TD]
[TD="align: right"]3[/TD]
[/TR]
[TR]
[TD]0671677[/TD]
[TD="align: right"]0.75[/TD]
[/TR]
[TR]
[TD]5469259[/TD]
[TD="align: right"]1.5[/TD]
[/TR]
[TR]
[TD]2404135[/TD]
[TD="align: right"]1[/TD]
[/TR]
[TR]
[TD]2404135[/TD]
[TD="align: right"]0[/TD]
[/TR]
[TR]
[TD]1283456[/TD]
[TD="align: right"]4[/TD]
[/TR]
[TR]
[TD]7544737[/TD]
[TD="align: right"]1[/TD]
[/TR]
[TR]
[TD]1829748[/TD]
[TD="align: right"]0[/TD]
[/TR]
[TR]
[TD]2822383[/TD]
[TD="align: right"]0[/TD]
[/TR]
[TR]
[TD]2822383[/TD]
[TD="align: right"]1.25[/TD]
[/TR]
[TR]
[TD]8953028[/TD]
[TD="align: right"]0[/TD]
[/TR]
[TR]
[TD]6259477[/TD]
[TD="align: right"]1.58[/TD]
[/TR]
[TR]
[TD]4507214[/TD]
[TD="align: right"]2[/TD]
[/TR]
[TR]
[TD]2006559[/TD]
[TD="align: right"]1.35[/TD]
[/TR]
[TR]
[TD]4507234[/TD]
[TD="align: right"]0.5[/TD]
[/TR]
[TR]
[TD]4507263[/TD]
[TD="align: right"]1[/TD]
[/TR]
[TR]
[TD]5518529[/TD]
[TD="align: right"]0.83[/TD]
[/TR]
[TR]
[TD]4069870[/TD]
[TD="align: right"]0[/TD]
[/TR]
[TR]
[TD]1142381[/TD]
[TD="align: right"]0.67[/TD]
[/TR]
[TR]
[TD]4838704[/TD]
[TD="align: right"]0
[/TD]
[/TR]
</tbody>[/TABLE]

This list will vary in size so I would like for it to look for the last row with data and complete the task within that range.

Any help would greatly be appreciated!!
 

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.
You could fill down a formula starting in C2:

Code:
=SUMIF($A$2:$A$24,A2,$B$2:$B$24)

If you want a macro:

Code:
Sub CombineItems()
Dim LR As Long, i As Integer, MyRg1 As Range, MyRg2 As Range
LR = Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To LR
    Set MyRg1 = Range("A2:A" & LR)
    Set MyRg2 = Range("B2:B" & LR)
    Cells(i, "C") = WorksheetFunction.SumIf(MyRg1, (Range("A" & i)), MyRg2)
Next i
End Sub

Then, you could remove duplicates if that's what you need.
 
Last edited:
Upvote 0
Code:
Sub CombineItems()
Dim LR As Long, i As Integer, MyRg1 As Range, MyRg2 As Range
LR = Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To LR
    Set MyRg1 = Range("A2:A" & LR)
    Set MyRg2 = Range("B2:B" & LR)
    Cells(i, "C") = WorksheetFunction.SumIf(MyRg1, (Range("A" & i)), MyRg2)
Next i

Set MyRg1 = Range("A1:C" & LR)
MyRg1.RemoveDuplicates Columns:=1, Header:=xlYes

End Sub
 
Upvote 0
Are you duplicates always next to each other as your example shows? If so, you can use this macro...
Code:
Sub consolidate()
  Dim Ar As Range
  With Range("A2", Cells(Rows.Count, "A").End(xlUp))
    .Value = Evaluate("IF(" & .Address & "=" & .Offset(-1).Address & ",""""," & .Address & ")")
    With .SpecialCells(xlBlanks)
      For Each Ar In .Areas
        Ar.Offset(-1, 1) = Ar.Offset(-1, 1) + Application.Sum(Ar.Offset(, 1))
      Next
    .EntireRow.Delete
    End With
  End With
End Sub
 
Last edited:
Upvote 0
Are you duplicates always next to each other as your example shows? If so, you can use this macro...
Code:
Sub consolidate()
  Dim Ar As Range
  With Range("A2", Cells(Rows.Count, "A").End(xlUp))
    .Value = Evaluate("IF(" & .Address & "=" & .Offset(-1).Address & ",""""," & .Address & ")")
    With .SpecialCells(xlBlanks)
      For Each Ar In .Areas
        Ar.Offset(-1, 1) = Ar.Offset(-1, 1) + Application.Sum(Ar.Offset(, 1))
      Next
    .EntireRow.Delete
    End With
  End With
End Sub
And if they might not always be next to each other, then you can use this code instead (or in place of the above code as I think it might be faster). One difference between the codes... the above code overwrites the existing data with the new layout whereas the code below outputs to the two columns next to your data...
Code:
Sub Consolidate()
  Dim R As Long, Data As Variant
  Data = Range("A2", Cells(Rows.Count, "B").End(xlUp))
  With CreateObject("Scripting.Dictionary")
    For R = 1 To UBound(Data)
      .Item(Data(R, 1)) = .Item(Data(R, 1)) + Data(R, 2)
    Next
    Range("C2").Resize(.Count) = Application.Transpose(.Keys)
    Range("D2").Resize(.Count) = Application.Transpose(.Items)
  End With
End Sub
 
Upvote 0

Similar threads

Forum statistics

Threads
1,223,239
Messages
6,170,947
Members
452,368
Latest member
jayp2104

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