Merging values where 2 other rows are the same

[sarunas221]

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

	NAME Surname	CODE	HOURS
	John Smith	410	8
	John Smith	410	6
	John Doe	410	8
	Jane Smith	410	7
	Jane Smith	410	7

<tbody>
</tbody>

To turn into this

	NAME Surname CODE HOURS
	John Smith 410 14 John Doe 410 8
	Jane Smith 410 14

<tbody>
</tbody>

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

 

[Fluff]

Maybe

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

 

[sarunas221]

Maybe

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!

 

[Fluff]

Glad to help & thanks for the feedback