How to combine some cells in different row with the same client and product codes

[billmark]

Client No	Product Code	Quantity	Cost	Value
456	BOX8478	300	8945.58	10456.87
456	215738	400	12	4847
5150	656568508	10000	41654	8794163
5152	87132P102	400	41820.04	44000.58
456	215738	800	11.25	1548.69

<tbody>
</tbody>

Hi
The above is the extract from a data worksheet which has over 15K+ rows and 50 columns. I want to use VBA macro to combine the quantity, cost and value if the client and product is the same.

eg client 456 has the same product 215738, combine quantity, cost and value to one of the row then delete the row.

Client No	Product Code	Quantity	Cost	Value
456	BOX8478	300	8945.58	10456.87
456	215738	1200	411	1948
5150	656568508	10000	41654	8794163
5152	87132P102	400	41820.04	44000.58

<tbody>
</tbody>

Please help how to as I have used the excel function such as sort the client then product, manually add and delete the row.

Regards
Bill

 

[hiker95]

billmark,

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

2. Are you using a PC or a Mac?

Here is a macro solution for you to consider.

You can change the raw data worksheet name in the macro.

Sample raw data:

Excel 2007
	A	B	C	D	E
1	Client No	Product Code	Quantity	Cost	Value
2	456	BOX8478	300	8945.58	10456.87
3	456	215738	400	12	4847
4	5150	656568508	10000	41654	8794163
5	5152	87132P102	400	41820.04	44000.58
6	456	215738	800	11.25	1548.69
7
Sheet1

After the macro:

Excel 2007
	A	B	C	D	E
1	Client No	Product Code	Quantity	Cost	Value
2	456	215738	1200	23.25	6395.69
3	456	BOX8478	300	8945.58	10456.87
4	5150	656568508	10000	41654	8794163
5	5152	87132P102	400	41820.04	44000.58
6
7
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.

Sub ConsolidateData()
' hiker95, 07/03/2015, ME865803
Dim lr As Long, r As Long, n As Long
Application.ScreenUpdating = False
With Sheets("Sheet1")   '<-- you can change the sheet name here
  lr = .Cells(Rows.Count, 1).End(xlUp).Row
  .Range("A2:E" & lr).Sort key1:=.Range("A2"), order1:=1, key2:=.Range("B2"), order2:=1
  With .Range("F2:F" & lr)
    .Formula = "=A2&B2"
    .Value = .Value
  End With
  For r = 2 To lr
    n = Application.CountIf(.Columns(6), .Cells(r, 6).Value)
    If n > 1 Then
      .Range("C" & r).Value = Evaluate("=Sum(C" & r & ":C" & r + n - 1 & ")")
      .Range("D" & r).Value = Evaluate("=Sum(D" & r & ":D" & r + n - 1 & ")")
      .Range("E" & r).Value = Evaluate("=Sum(E" & r & ":E" & r + n - 1 & ")")
      .Range("A" & r + 1 & ":E" & r + n - 1).ClearContents
    End If
    r = r + n - 1
  Next r
  .Range("F2:F" & lr).ClearContents
  .Range("A2:E" & lr).SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
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, and, answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.

Then run the ConsolidateData macro.

 

[billmark]

Thank you. It works when I apply to the whole data file.

 

[hiker95]

billmark,

Thanks for the feedback.

You are very welcome. Glad I could help.

And, come back anytime.

 

[billmark]

Client No	Product Code	Quantity	Cost	Value	other
456	BOX8478	300	8945.58	10456.87	457
456	215738	400	545	4847
5150	656568508	10000	41654	8794163	799
5152	87132P102	400	41820.04	44000.58
456	215738	800	54.5	1548.69	457

<colgroup><col style="mso-width-source:userset;mso-width-alt:2112;width:50pt" width="66"> <col style="mso-width-source:userset;mso-width-alt:3072;width:72pt" width="96"> <col style="mso-width-source:userset;mso-width-alt:2048;width:48pt" width="64"> <col style="mso-width-source:userset;mso-width-alt:2272; width:53pt" span="2" width="71"> <col style="width:54pt" width="72"> </colgroup><tbody>
</tbody>

Hi
I've added one column 'other' and some of the cells are blank. After running the macro (modified the macro to include the new column or row), the cell under the column 'other' shifted up. Please advise how to modify the code so as to delete the whole blank row instead of the blank cell.

Regards

 

[hiker95]

billmark,

Here is a new macro solution for you to consider based on the new raw data structure.

You can change the raw data worksheet name in the macro.

New sample raw data:

Excel 2007
	A	B	C	D	E	F
1	Client No	Product Code	Quantity	Cost	Value	other
2	456	BOX8478	300	8945.58	10456.87	457
3	456	215738	400	545	4847
4	5150	656568508	10000	41654	8794163	799
5	5152	87132P102	400	41820.04	44000.58
6	456	215738	800	54.5	1548.69	457
7
Sheet1

After the new macro:

Excel 2007
	A	B	C	D	E	F
1	Client No	Product Code	Quantity	Cost	Value	other
2	456	215738	1200	599.5	6395.69	457
3	456	BOX8478	300	8945.58	10456.87	457
4	5150	656568508	10000	41654	8794163	799
5	5152	87132P102	400	41820.04	44000.58
6
7
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).

Sub ConsolidateData_V2()
' hiker95, 08/26/2015, ME865803
Dim lr As Long, r As Long, n As Long
Application.ScreenUpdating = False
With Sheets("Sheet1")   '<-- you can change the sheet name here
  lr = .Cells(Rows.Count, 1).End(xlUp).Row
  .Range("A2:F" & lr).Sort key1:=.Range("A2"), order1:=1, key2:=.Range("B2"), order2:=1
  With .Range("G2:G" & lr)
    .Formula = "=A2&B2"
    .Value = .Value
  End With
  For r = 2 To lr
    n = Application.CountIf(.Columns(7), .Cells(r, 7).Value)
    If n > 1 Then
      .Range("C" & r).Value = Evaluate("=Sum(C" & r & ":C" & r + n - 1 & ")")
      .Range("D" & r).Value = Evaluate("=Sum(D" & r & ":D" & r + n - 1 & ")")
      .Range("E" & r).Value = Evaluate("=Sum(E" & r & ":E" & r + n - 1 & ")")
      .Range("F" & r).Value = Evaluate("=Sum(F" & r & ":F" & r + n - 1 & ")")
      .Range("A" & r + 1 & ":F" & r + n - 1).ClearContents
    End If
    r = r + n - 1
  Next r
  .Range("G2:G" & lr).ClearContents
  .Range("A2:F" & lr).SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
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, and, answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.

Then run the ConsolidateData_V2 macro.


If the above is not correct, because you have not supplied a screenshot of what the new results should look like, then:

Please supply a screenshot of what the correct results should look like.

 

[billmark]

Hi
I have the example for your reference
The original table to be used:

Client	Product Code	Quantity	Cost	Market Value	other	other1	other2	other3	other4	other5
CLTA	456	9.698	96.98	96.98	55	10	546	65465	4654
CLTA	2546	2658015.45	3413316.3	3476938.86		1
CLTA	EJRWER	100	130.01	130.81		1
CLTA	0OWE9R	-2074.9	-2702.37	-2714.17		1
CLTC	000324AA1	2115670	2362088.78	2746742.81		99.25	000324AA1	000324AA1	BNGK543	12
CLTC	001272AA1	3151474	3700336.15	4053772.52	2	128.631	001272AA1	001272AA1	B1VSYJ6	6.032
CLTC	00130HBS3	560000	563803.7	803955.68		109.75	00130HBS3	00130HBS3	B8J7VH1	7.375
CLTC	00206R102	246600	9332522.09	11206305.02		34.74	00206R102	00206R102	2831811
CLTC	00206R102	96500	3988226.12	4385273.46		34.74	00206R102	00206R102	2831811
CLTC	00208D408	242300	5439409.91	4741811		19.57	00208D408	00208D408	B6463M8
CLTC	00289RAA0	2822000	2990590.29	3525331.28		95.5	00289RAA0	00289RAA0	B5BDZ74	8.875
CLTC	00289VAB9	3422000	3826662.4	3525089.28		78.75	00289VAB9	00289VAB9	00289VAB9	7.75

<colgroup><col><col><col><col><col><col><col><col span="2"><col><col></colgroup><tbody>
</tbody>

After running the macro:
Sub ConsolidateData()
' hiker95, 07/03/2015, ME865803
Dim lr As Long, r As Long, n As Long
Application.ScreenUpdating = False
With Sheets("Sheet1") '<-- you can change the sheet name here
lr = .Cells(Rows.Count, 1).End(xlUp).Row
.Range("A2:k" & lr).Sort key1:=.Range("A2"), order1:=1, key2:=.Range("b2"), order2:=1
With .Range("l2:l" & lr)
.Formula = "=A2&b2"
.Value = .Value
End With
For r = 2 To lr
n = Application.CountIf(.Columns(12), .Cells(r, 12).Value)
If n > 1 Then
.Range("c" & r).Value = Evaluate("=Sum(c" & r & ":c" & r + n - 1 & ")")
.Range("d" & r).Value = Evaluate("=Sum(d" & r & ":d" & r + n - 1 & ")")
.Range("e" & r).Value = Evaluate("=Sum(e" & r & ":e" & r + n - 1 & ")")
.Range("A" & r + 1 & ":k" & r + n - 1).ClearContents
End If
r = r + n - 1
Next r
.Range("l2:l" & lr).ClearContents
.Range("A2:k" & lr).SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
End With
Application.ScreenUpdating = True
End Sub

But the result, other2, other3, other4 and other5 have shifted up:

Client	Product Code	Quantity	Cost	Market Value	other	other1	other2	other3	other4	other5
CLTA	0OWE9R	-2074.9	-2702.37	-2714.17	55	1	546	65465	4654	12
CLTA	2546	2658015.45	3413316.3	3476938.86	2	1	000324AA1	000324AA1	BNGK543	6.032
CLTA	456	9.698	96.98	96.98		10	001272AA1	001272AA1	B1VSYJ6	7.375
CLTA	EJRWER	100	130.01	130.81		1	00130HBS3	00130HBS3	B8J7VH1	8.875
CLTC	000324AA1	2115670	2362088.78	2746742.81		99.25	00206R102	00206R102	2831811	7.75
CLTC	001272AA1	3151474	3700336.15	4053772.52		128.631	00208D408	00208D408	B6463M8
CLTC	00130HBS3	560000	563803.7	803955.68		109.75	00289RAA0	00289RAA0	B5BDZ74
CLTC	00206R102	343100	13320748.2	15591578.48		34.74	00289VAB9	00289VAB9	00289VAB9
CLTC	00208D408	242300	5439409.91	4741811		19.57
CLTC	00289RAA0	2822000	2990590.29	3525331.28		95.5
CLTC	00289VAB9	3422000	3826662.4	3525089.28		78.75

<colgroup><col><col><col><col><col><col><col><col span="2"><col><col></colgroup><tbody>
</tbody>

I expect the outcome:

Client	Product Code	Quantity	Cost	Market Value	other	other1	other2	other3	other4	other5
CLTA	0OWE9R	-2074.9	-2702.37	-2714.17		1
CLTA	2546	2658015.45	3413316.3	3476938.86		1
CLTA	456	9.698	96.98	96.98	55	10	546	65465	4654
CLTA	EJRWER	100	130.01	130.81		1
CLTC	000324AA1	2115670	2362088.78	2746742.81		99.25	000324AA1	000324AA1	BNGK543	12
CLTC	001272AA1	3151474	3700336.15	4053772.52	2	128.631	001272AA1	001272AA1	B1VSYJ6	6.032
CLTC	00130HBS3	560000	563803.7	803955.68		109.75	00130HBS3	00130HBS3	B8J7VH1	7.375
CLTC	00206R102	343100	13320748.2	15591578.48		34.74	00206R102	00206R102	2831811
CLTC	00208D408	242300	5439409.91	4741811		19.57	00208D408	00208D408	B6463M8
CLTC	00289RAA0	2822000	2990590.29	3525331.28		95.5	00289RAA0	00289RAA0	B5BDZ74	8.875
CLTC	00289VAB9	3422000	3826662.4	3525089.28		78.75	00289VAB9	00289VAB9	00289VAB9	7.75

<colgroup><col><col><col><col><col><col><col><col span="2"><col><col></colgroup><tbody>
</tbody>

Please advise how to fix the code.

Regards
Bill

 

[hiker95]

billmark,

Here is NEW macro solution for you to consider based on the NEW raw data structure you have displayed.

You can change the raw data worksheet name in the macro.

New sample raw data:

Excel 2007
	A	B	C	D	E	F	G	H	I	J	K
1	Client	Product Code	Quantity	Cost	Market Value	other	other1	other2	other3	other4	other5
2	CLTA	456	9.698	96.98	96.98	55	10	546	65465	4654
3	CLTA	2546	2658015.45	3413316.3	3476938.86		1
4	CLTA	EJRWER	100	130.01	130.81		1
5	CLTA	0OWE9R	-2074.9	-2702.37	-2714.17		1
6	CLTC	000324AA1	2115670	2362088.78	2746742.81		99.25	000324AA1	000324AA1	BNGK543	12
7	CLTC	001272AA1	3151474	3700336.15	4053772.52	2	128.631	001272AA1	001272AA1	B1VSYJ6	6.032
8	CLTC	00130HBS3	560000	563803.7	803955.68		109.75	00130HBS3	00130HBS3	B8J7VH1	7.375
9	CLTC	00206R102	246600	9332522.09	11206305.02		34.74	00206R102	00206R102	2831811
10	CLTC	00206R102	96500	3988226.12	4385273.46		34.74	00206R102	00206R102	2831811
11	CLTC	00208D408	242300	5439409.91	4741811		19.57	00208D408	00208D408	B6463M8
12	CLTC	00289RAA0	2822000	2990590.29	3525331.28		95.5	00289RAA0	00289RAA0	B5BDZ74	8.875
13	CLTC	00289VAB9	3422000	3826662.4	3525089.28		78.75	00289VAB9	00289VAB9	00289VAB9	7.75
14
Sheet1

After the new macro:

Excel 2007
	A	B	C	D	E	F	G	H	I	J	K
1	Client	Product Code	Quantity	Cost	Market Value	other	other1	other2	other3	other4	other5
2	CLTA	456	9.698	96.98	96.98	55	10	546	65465	4654
3	CLTA	2546	2658015.45	3413316.3	3476938.86		1
4	CLTA	0OWE9R	-2074.9	-2702.37	-2714.17		1
5	CLTA	EJRWER	100	130.01	130.81		1
6	CLTC	000324AA1	2115670	2362088.78	2746742.81		99.25	000324AA1	000324AA1	BNGK543	12
7	CLTC	001272AA1	3151474	3700336.15	4053772.52	2	128.631	001272AA1	001272AA1	B1VSYJ6	6.032
8	CLTC	00130HBS3	560000	563803.7	803955.68		109.75	00130HBS3	00130HBS3	B8J7VH1	7.375
9	CLTC	00206R102	343100	13320748.2	15591578.48		34.74	00206R102	00206R102	2831811
10	CLTC	00208D408	242300	5439409.91	4741811		19.57	00208D408	00208D408	B6463M8
11	CLTC	00289RAA0	2822000	2990590.29	3525331.28		95.5	00289RAA0	00289RAA0	B5BDZ74	8.875
12	CLTC	00289VAB9	3422000	3826662.4	3525089.28		78.75	00289VAB9	00289VAB9	00289VAB9	7.75
13
14
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).

Sub ConsolidateData_V3()
Dim lr As Long, r As Long, n As Long
Application.ScreenUpdating = False
With Sheets("Sheet1")   '<-- you can change the sheet name here
  lr = .Cells(Rows.Count, 1).End(xlUp).Row
  .Range("A2:K" & lr).Sort key1:=.Range("A2"), order1:=1, key2:=.Range("B2"), order2:=1
  With .Range("L2:L" & lr)
    .Formula = "=A2&B2"
    .Value = .Value
  End With
  For r = 2 To lr
    n = Application.CountIf(.Columns(12), .Cells(r, 12).Value)
    If n > 1 Then
      .Range("C" & r).Value = Evaluate("=Sum(C" & r & ":C" & r + n - 1 & ")")
      .Range("D" & r).Value = Evaluate("=Sum(D" & r & ":D" & r + n - 1 & ")")
      .Range("E" & r).Value = Evaluate("=Sum(E" & r & ":E" & r + n - 1 & ")")
      .Range("A" & r + 1 & ":A" & r + n - 1).ClearContents
    End If
    r = r + n - 1
  Next r
  .Range("L2:L" & lr).ClearContents
  lr = .Cells(Rows.Count, 2).End(xlUp).Row
  For r = lr To 2 Step -1
    If .Range("A" & r) = vbEmpty Then .Rows(r).Delete
  Next r
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, and, answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.

Then run the ConsolidateData_V3 macro.

 

[billmark]

Hi
Thank you. It works and save me a lot of time.

Regards
Bill

 

[hiker95]

billmark,

Thanks for the feedback.

You are very welcome. Glad I could help.

And, come back anytime.