VBA sum data in certain columns based on common data

[Forrtis]

I have a very similar problem to the one in the link below:

https://www.mrexcel.com/forum/excel...plicate-rows-sum-values-certain-column-4.html

The only difference is the formatting of the data. The unsorted data comes in the following format:

	G	H	I	J	K	L	M	N
1	ID	Name	Blank column	Blank Column	Blank Column	Quantity	Unit price	Total
2	23	X1				Y1	5	L*M
3	41	X2				Y2	15	L*M
4	41	X2				Y3	15	L*M
5	23	X1				Y4	5	L*M
6	41	X2				Y5	15	L*M

<tbody>
</tbody>

The expected results is similar to the quoted thread, although there are slight differences:

• Columns L and N need to be summed
• Columns I, J and K need to stay blank
• Any number of rows may contain common data in cells belonging to columns G, H and M
  • Values in Column M may be common for two different ID's therefore this column cannot be used as a guide to consolidate the data
  • Either Column G or H can be used to look for common data and then the common rows need to be summed - only summing the columns indicated above
• There are ~100 different ID's to work with so the code needs to be able to handle this

	G	H	I	J	K	L	M	N
1	ID	Name	Blank column	Blank Column	Blank Column	Quantity	Unit price	Total
2	23	X1				Y1+Y4	5	L*M
3	41	X2				Y2+Y3+Y5	15	L*M

<tbody>
</tbody>

Any help would be greatly appreciated!
****** id="cke_pastebin" style="position: absolute; top: 573px; width: 1px; height: 1px; overflow: hidden; left: -1000px;">

L*M

<tbody>
</tbody>

aNYa</body>

 

[Forrtis]

I have shifted everything to the right because I added some columns, however I have changed the code accordingly and it has worked fine until the problem that I have described above.
Please see attached file as requested.


https://app.box.com/s/09u9lazadghaegq3m2qh1rmq0bdwhamw

There are two cases that I have found the code not to work in:
- if you press the button in A2 until no data is left
- if you press the button in A3 until only one range of data is left

Try for yourself if you like, thanks for your help again!

 

[MickG]

Try the below:=
Add line show in red and a "1" in Red
also add a "End if" at the bottom of the code

With Sheets("DN Compile")
     Set Rng = .Range("J2", .Range("J" & Rows.Count).End(xlUp))
End With
[COLOR="#FF0000"][B]If Not Rng(1).Address(0, 0) = "J1" Then
[/B][/COLOR]With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
ReDim Ray(1 To Rng.Count [COLOR="#FF0000"][SIZE=4][B]+ 1,[/B][/SIZE][/COLOR] 1 To 8)

 

[Forrtis]

Works perfectly! Thank you once again!

 

[MickG]

You're welcome