Merging values where 2 other rows are the same

sarunas221

New Member
Joined
Aug 28, 2018
Messages
4
I found this code on the forums posted by MickG:
Sub MG02Sep59
Dim Rng As Range, Dn As Range, n As Long, nRng As Range
Set Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
For Each Dn In Rng
If Not .Exists(Dn.Value) Then
.Add Dn.Value, Dn
Else
If nRng Is Nothing Then Set nRng = _
Dn Else Set nRng = Union(nRng, Dn)
.Item(Dn.Value).Offset(, 3) = .Item(Dn.Value).Offset(, 3) + Dn.Offset(, 3)
End If
Next
If Not nRng Is Nothing Then nRng.EntireRow.Delete
End With
End Sub
this code is amazing. it does almost exactly what i need but i need it to compare the not only A range but B range too.
Set Rng = Range(Range("A20"), Range("B" & Rows.Count).End(xlUp))

I tried altering the range i need so it would select 2 columbs instead of 1 but the code gives me an arror
Run-time error '1004': Cannot use that command on overlapping selections

The error appears on the nRgn.EntireRow.Delete code

Would anyone know how to fix this issue?

This is a good enough example of my information John is culumn A Smith is column B

[TABLE="class: cms_table, width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]NAME Surname[/TD]
[TD]CODE[/TD]
[TD]HOURS[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]John Smith[/TD]
[TD]410[/TD]
[TD]8[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]John Smith[/TD]
[TD]410[/TD]
[TD]6[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]John Doe[/TD]
[TD]410[/TD]
[TD]8[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Jane Smith[/TD]
[TD]410[/TD]
[TD]7[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Jane Smith[/TD]
[TD]410[/TD]
[TD]7[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]


To turn into this

[TABLE="class: cms_table, width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]NAME Surname CODE HOURS[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]John Smith 410 14
John Doe 410 8 [/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Jane Smith 410 14[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]


As of now the code would ignore If john is a Smith or a Doe and put their hours together
 

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".
Maybe
Code:
Sub MG02Sep59()
   Dim Rng As Range, Dn As Range, n As Long, nRng As Range, V As String
   Set Rng = Range(Range("A2"), Range("A" & Rows.count).End(xlUp))
   With CreateObject("scripting.dictionary")
      .CompareMode = vbTextCompare
      For Each Dn In Rng
         V = Dn.Value & "|" & Dn.Offset(, 1).Value
         If Not .Exists(V) Then
            .Add V, Dn
         Else
            If nRng Is Nothing Then Set nRng = Dn Else Set nRng = Union(nRng, Dn)
            .Item(V).Offset(, 3) = .Item(V).Offset(, 3) + Dn.Offset(, 3)
         End If
      Next
      If Not nRng Is Nothing Then nRng.EntireRow.delete
   End With
End Sub
 
Upvote 0
Maybe
Code:
Sub MG02Sep59()
   Dim Rng As Range, Dn As Range, n As Long, nRng As Range, V As String
   Set Rng = Range(Range("A2"), Range("A" & Rows.count).End(xlUp))
   With CreateObject("scripting.dictionary")
      .CompareMode = vbTextCompare
      For Each Dn In Rng
         V = Dn.Value & "|" & Dn.Offset(, 1).Value
         If Not .Exists(V) Then
            .Add V, Dn
         Else
            If nRng Is Nothing Then Set nRng = Dn Else Set nRng = Union(nRng, Dn)
            .Item(V).Offset(, 3) = .Item(V).Offset(, 3) + Dn.Offset(, 3)
         End If
      Next
      If Not nRng Is Nothing Then nRng.EntireRow.delete
   End With
End Sub

Thank you soo much! Tested this and it works perfectly!
 
Upvote 0
Glad to help & thanks for the feedback
 
Upvote 0

Forum statistics

Threads
1,223,911
Messages
6,175,325
Members
452,635
Latest member
laura12345

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