VBA code snippet to consolidate/Sum

F3hunter · Jan 17, 2015

Hi,

I am your average Excel user having a hard time trying an end result that will work for me. Horrid VBA skills here. I have tried Pivot Tables (Too busy), I ave tried SUMIFS as well to no avail.

If someone could help that would be awesome. I am looking for code to do the following,
Consolidate the redundant items in Product column A, sum the values from those in columns Pounds D and Total F. All this and keep the consolidation/SUM to each specific category.

Each product item can be in a different "Category" which is what is giving me a headache trying to figure this out.

What it looks like before consolidation:

Product Code	Description	Category	Pounds	Price	Total
1111	SC	12NBCBER	40.00	$3.40	$136.00
1111	SC	12NBCBER	20.00	$3.40	$68.00
1111	SC	12NBCBER	40.00	$3.40	$136.00
1111	SC	12NBCBER	100.00	$3.40	$340.00
1111	SC	12NBCBER	20.00	$3.40	$68.00
1112	NLR	12NBCBER	20.00	$6.22	$124.40
1112	NLR	12NBCBER	20.00	$6.22	$124.40
1113	Wh	12NBCBER	300.00	$2.95	$885.00
1113	Wh	12NBCBER	200.00	$2.95	$590.00
1113	Wh	12NBCBER	200.00	$2.95	$590.00
1113	Wh	12NBCBER	700.00	$2.95	$2065.00
1114	Bl1	12NBCBER	60.00	$10.18	$610.80
1114	Bl1	12NBCBER	100.00	$10.18	$1018.00
1114	Bl1	12NBCBER	340.00	$10.18	$3461.20
1115	Bl2	12NBCBER	80.00	$10.18	$814.40
1115	Bl2	12NBCBER	80.00	$10.18	$814.40
1115	Bl2	12NBCBER	300.00	$10.18	$3054.00
1115	Bl2	12NBCBER	40.00	$10.18	$407.20
1116	2935	12NBCBER	20.00	$13.50	$270.00
1117	G	12NBCBER	91.00	$5.68	$516.88
1117	G	12NBCBER	40.00	$5.68	$227.20
1117	G	12NBCBER	40.00	$5.68	$227.20
1117	G	12NBCBER	100.00	$5.68	$568.00
1118	Mod Bl	12NBCBER	60.00	$9.67	$580.20
1118	Mod Bl	12NBCBER	40.00	$9.67	$386.80
1118	Mod Bl	12NBCBER	40.00	$9.67	$386.80
1118	Mod Bl	12NBCBER	120.00	$9.67	$1160.40
1119	CY	12NBCSD	20.00	$6.52	$130.40
1119	CY	12NBCSD	60.00	$6.52	$391.20
1111	SC	12NBCSD	40.00	$3.40	$136.00
1113	Wh	12NBCSD	50.00	$2.95	$147.50
1113	Wh	12NBCSD	25.00	$2.95	$73.75
1113	Wh	12NBCSD	50.00	$2.95	$147.50
1113	Wh	12NBCSD	150.00	$2.95	$442.50
1120	RBB	12NBCSD	20.00	$6.17	$123.40
1121	BW	12NBCSD	25.00	$3.97	$99.25
1122	Br	12NBCSD	160.00	$13.50	$2160.00
1123	RB	12NBCSD	40.00	$6.17	$246.80
1124	DG	12NBCSD	17.00	$13.45	$228.65
1125	DB	12NBCSD	20.00	$9.15	$183.00
1125	DB	12NBCSD	40.00	$9.15	$366.00
1125	DB	12NBCSD	20.00	$9.15	$183.00
1125	DB	12NBCSD	20.00	$9.15	$183.00
1126	Grove	12NBCSD	17.00	$6.70	$113.90
1127	Hc	12NBCSD	10.00	$6.17	$61.70
1128	Ha	12NBCSD	40.00	$7.61	$304.40
1129	Fr	12NBCSD	10.00	$13.45	$134.50
1130	Pr	12NBCSD	20.00	$6.38	$127.60
1130	Pr	12NBCSD	20.00	$6.38	$127.60
1130	Pr	12NBCSD	40.00	$6.38	$255.20
1131	Pb	12NBCSD	20.00	$9.67	$193.40
1131	Pb	12NBCSD	40.00	$9.67	$386.80
1131	Pb	12NBCSD	60.00	$9.67	$580.20
1132	MRR	12NBCSD	20.00	$6.70	$134.00
1133	220	12NBCSD	80.00	$6.70	$536.00
1134	PBB	12NBCSD	260.00	$10.89	$2831.40
1134	PBB	12NBCSD	140.00	$10.89	$1524.60
1134	PBB	12NBCSD	300.00	$10.89	$3267.00
1111	SC	16NBCBER	20.00	$3.40	$68.00
1114	Bl1	16NBCBER	60.00	$10.18	$610.80
1115	Bl2	16NBCBER	80.00	$10.18	$814.40
1135	MLG	16NBCSD	10.00	$7.61	$76.10
1121	BW	16NBCSD	25.00	$3.97	$99.25
1125	DB	16NBCSD	60.00	$9.15	$549.00
1135	pp	12BCBER	20.00	$7.65	$153.00

What I need it to like like after:

Product Code	Description	Category	Pounds	Price	Total
1111	SC	12NBCBER	220.00	$ 3.40	$748.00
1112	NLR	12NBCBER	40.00	$ 6.22	$248.80
1113	Wh	12NBCBER	1400.00	$ 2.95	$4130.00
1135	pp	12BCBER	20.00	$ 7.65	$153.00
1119	CY	12NBCSD	80.00	$ 6.52	$521.60
1113	Wh	12NBCSD	275.00	$ 2.95	$811.25

Thanks in advance for any help you can offer.

F3hunter · Jan 17, 2015

After scouring the internet I located several snippets and have tried to break them down to understand them. I have put this code together and it partially works, but does not seem to be grabbing all the data in column A and is not summing the duplicate data.

Here is the code that I have sewn together:

Private Sub CommandButton21_Click()

Set wsCopy = Sheets("Sheet1")
Set wsPaste = Sheets("Sheet2")
lBR = wsCopy.Cells(Application.Rows.Count, "A").End(xlUp).Row
Set rCopy = wsCopy.Range("A1:F" & lBR)
Set rPaste = wsPaste.Range("A1:F" & lBR)
rCopy.Copy rPaste
rPaste.RemoveDuplicates Columns:=Array(1), Header _
:=xlYes
wsPaste.Range("D:D").Formula = "=SUMIFS(Sheet1!D:D,Sheet1!A:A,Sheet1!C:C,Sheet2!C:C)"
wsPaste.Range("F:F").Formula = "=SUMIFS(Sheet1!F:F,Sheet1!A:A,Sheet1!C:C,Sheet2!C:C)"
lBR = wsPaste.Cells(Application.Rows.Count, "A").End(xlUp).Row

Set rPaste = wsPaste.Range("A1:F" & lBR)
rPaste.Copy
rPaste.PasteSpecial xlPasteValues

End Sub

hiker95 · Jan 17, 2015

F3hunter,

Welcome to the MrExcel forum.

1. What version of Excel and Windows are you using?

2. Are you using a PC or a Mac?

Sample raw data in worksheet Sheet1 (the worksheet name can be changed in the macro):

Excel 2007

A

B

C

D

E

F

1

Product Code

Description

Category

Pounds

Price

Total

2

1111

SC

12NBCBER

220

$3.40

$748.00

3

1111

SC

12NBCSD

40

$3.40

$136.00

4

1111

SC

16NBCBER

20

$3.40

$68.00

5

1112

NLR

12NBCBER

40

$6.22

$248.80

6

1113

Wh

12NBCBER

1400

$2.95

$4,130.00

7

1113

Wh

12NBCSD

275

$2.95

$811.25

8

1114

Bl1

12NBCBER

500

$10.18

$5,090.00

9

1114

Bl1

16NBCBER

60

$10.18

$610.80

10

1115

Bl2

12NBCBER

500

$10.18

$5,090.00

11

1115

Bl2

16NBCBER

80

$10.18

$814.40

12

1116

2935

12NBCBER

20

$13.50

$270.00

13

1117

G

12NBCBER

271

$5.68

$1,539.28

14

1118

Mod Bl

12NBCBER

260

$9.67

$2,514.20

15

1119

CY

12NBCSD

80

$6.52

$521.60

16

1120

RBB

12NBCSD

20

$6.17

$123.40

17

1121

BW

12NBCSD

25

$3.97

$99.25

18

1121

BW

16NBCSD

25

$3.97

$99.25

19

1122

Br

12NBCSD

160

$13.50

$2,160.00

20

1123

RB

12NBCSD

40

$6.17

$246.80

21

1124

DG

12NBCSD

17

$13.45

$228.65

22

1125

DB

12NBCSD

100

$9.15

$915.00

23

1125

DB

16NBCSD

60

$9.15

$549.00

24

1126

Grove

12NBCSD

17

$6.70

$113.90

25

1127

Hc

12NBCSD

10

$6.17

$61.70

26

1128

Ha

12NBCSD

40

$7.61

$304.40

27

1129

Fr

12NBCSD

10

$13.45

$134.50

28

1130

Pr

12NBCSD

80

$6.38

$510.40

29

1131

Pb

12NBCSD

120

$9.67

$1,160.40

30

1132

MRR

12NBCSD

20

$6.70

$134.00

31

1133

220

12NBCSD

80

$6.70

$536.00

32

1134

PBB

12NBCSD

700

$10.89

$7,623.00

33

1135

MLG

16NBCSD

10

$7.61

$76.10

34

1135

pp

12BCBER

20

$7.65

$153.00

35

Sheet1

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code
2. Open your NEW workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Code:

Sub ConsolidateData()
' hiker95, 01/17/2015, ME829707
Dim oa As Variant
Dim lr As Long, r As Long, nr As Long, n As Long
Application.ScreenUpdating = False
With Sheets("Sheet1")
  .Columns("I:N").ClearContents
  .Cells(1, 9).Resize(, 6).Value = .Cells(1, 1).Resize(, 6).Value
  lr = .Cells(Rows.Count, 1).End(xlUp).Row
  oa = .Range("A2:F" & lr)
  With .Range("G2:G" & lr)
    .Formula = "=A2&B2&C2"
    .Value = .Value
  End With
  .Range("A2:G" & lr).Sort key1:=.Range("G2"), order1:=1
  nr = 1
  For r = 2 To lr
    n = Application.CountIf(.Columns(7), .Cells(r, 7).Value)
    nr = nr + 1
    If n = 1 Then
      .Cells(nr, 9).Resize(, 6).Value = .Cells(r, 1).Resize(, 6).Value
    Else
      .Cells(nr, 9).Resize(, 3).Value = .Cells(r, 1).Resize(, 3).Value
      .Cells(nr, 12).Value = Evaluate("=Sum(D" & r & ":D" & r + n - 1 & ")")
      .Cells(nr, 13).Value = .Cells(r, 5).Value
      .Cells(nr, 14).Value = Evaluate("=Sum(F" & r & ":F" & r + n - 1 & ")")
    End If
    r = r + n - 1
  Next r
  .Range("M2:M" & nr).NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"
  .Range("N2:N" & nr).NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"
  .Range("A2:F" & lr) = oa
  .Range("G2:G" & lr).ClearContents
  .Columns("I:N").AutoFit
End With
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the ConsolidateData macro.

F3hunter · Jan 17, 2015

Hiker95-Wow..Worked perfectly, I've spent days on this and must extend my sincerest gratitude. I'll study that code to get a better understanding of how it works so when the next project comes I will be better prepared. Have a great weekend!

Windows 8.1
Excel 2010

F3

hiker95 · Jan 18, 2015

F3hunter,

Thanks for the feedback.

You are very welcome. Glad I could help.

And, come back anytime.

I missed your posted macro - you are using two worksheets.

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Code:

Sub ConsolidateData_V2()
' hiker95, 01/17/2015, ME829707
Dim w1 As Worksheet, w2 As Worksheet
Dim oa As Variant
Dim lr As Long, r As Long, nr As Long, n As Long
Application.ScreenUpdating = False
Set w1 = Sheets("Sheet1")
Set w2 = Sheets("Sheet2")
With w2
  .UsedRange.ClearContents
  .Range("A1").Resize(, 6).Value = w1.Range("A1").Resize(, 6).Value
End With
With w1
  lr = .Cells(Rows.Count, 1).End(xlUp).Row
  oa = .Range("A2:F" & lr)
  With .Range("G2:G" & lr)
    .Formula = "=A2&B2&C2"
    .Value = .Value
  End With
  .Range("A2:G" & lr).Sort key1:=.Range("G2"), order1:=1
  nr = 1
  For r = 2 To lr
    n = Application.CountIf(.Columns(7), .Cells(r, 7).Value)
    nr = nr + 1
    If n = 1 Then
      w2.Cells(nr, 1).Resize(, 6).Value = w1.Cells(r, 1).Resize(, 6).Value
    Else
      w2.Cells(nr, 1).Resize(, 3).Value = w1.Cells(r, 1).Resize(, 3).Value
      w2.Cells(nr, 4).Value = Evaluate("=Sum(D" & r & ":D" & r + n - 1 & ")")
      w2.Cells(nr, 5).Value = w1.Cells(r, 5).Value
      w2.Cells(nr, 6).Value = Evaluate("=Sum(F" & r & ":F" & r + n - 1 & ")")
    End If
    r = r + n - 1
  Next r
  w2.Range("E2:E" & nr).NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"
  w2.Range("F2:F" & nr).NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"
  .Range("A2:F" & lr) = oa
  .Range("G2:G" & lr).ClearContents
  w2.Columns("A:F").AutoFit
End With
w2.Activate
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the ConsolidateData_V2 macro.

F3hunter · Jan 18, 2015

Yes, I was using 2 worksheets and thank you for noticing that and spending the time to change it up. Again, it worked perfectly!

My wife is happy as well! Spend a little time with her this weekend now.

hiker95 · Jan 18, 2015

F3hunter,

Thanks for the feedback.

You are very welcome. Glad I could help.

And, come back anytime.

VBA code snippet to consolidate/Sum

F3hunter

New Member

Excel Facts

F3hunter

New Member

hiker95

Well-known Member

F3hunter

New Member

hiker95

Well-known Member

F3hunter

New Member

hiker95

Well-known Member

Similar threads

Forum statistics

Share this page

VBA code snippet to consolidate/Sum

F3hunter

New Member

Excel Facts

F3hunter

New Member

hiker95

Well-known Member

F3hunter

New Member

hiker95

Well-known Member

F3hunter

New Member

hiker95

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock