Merging duplicates in a sheet

[David]

Hello, can anyone help with this?

I've got a table of data, basically it's rows with URLs (Col C) in it
and stats such as how many "hits" (Col E) each received.

What I need to do is search through the data and if any URLs are
duplicates, I need to remove the duplicate row while adding up the
total hits received for both rows and then writing this total back
into Col E of the original row.

This is what I have so far:

Dim rCell As Range

For Each rCell In Range("C1:C5000")

sURL = rCell.Value
iTotal = rCell.Offset(2, 0).Value

MsgBox sURL, iTotal

' Now check to see if we have a duplicate
iFlag = 1

'Range(Cells(BeginRow, BeginCol),Cells(L, col))

For Each rCheckCell In Range("C1:C5000")

sCheck = rCheckCell.Value

If sCheck = sURL Then

' We've got a match. Remove the duplicate row and add the
figures before writing them.


End If

Next rCheckCell

Next rCell

End Sub

I need the second loop to start at the row after the first loop, but I
don't know how that's done, anyone got any ideas?

If there's a better way to do this then please let me know!

Thanks.

 

[Mike H]

David,

Not extensively tested. Normally when deletring rows I would work backwards
through the range

Sub Stantial()
Dim rCheckCell
Dim rCell As Range
For Each rCell In Range("C1:C6")
sURL = rCell.Value
itotal = rCell.Offset(, 2).Value
MsgBox sURL & itotal
' Now check to see if we have a duplicate
iFlag = 1
For Each rCheckCell In Range("C" & rCell.Row + 1 & ":C5000")
sCheck = rCheckCell.Value
If sCheck = sURL Then
itotal = itotal + rCheckCell.Offset(, 2).Value
rCell.Offset(, 2).Value = itotal
rCheckCell.EntireRow.Delete
End If
Next rCheckCell
Next rCell
End Sub

Mike

 

[David]

Thanks Mike!

 

[David]

Thanks Mike!

One more thing.

If I wanted to simply search through all used rows, what changes would
I need to make? The spreadsheets vary in size so always searching to
row 5000 isn't efficient.

Thanks again!

 

[Mike H]

hi,
find the lastrow in col c

Sub Stantial()
Dim rCheckCell
Dim rCell As Range
lastrow = Cells(Cells.Rows.Count, "C").End(xlUp).Row
For Each rCell In Range("C1:C" & lastrow)
sURL = rCell.Value
itotal = rCell.Offset(, 2).Value
MsgBox sURL & itotal
' Now check to see if we have a duplicate
iFlag = 1
For Each rCheckCell In Range("C" & rCell.Row + 1 & ":C" & lastrow)
sCheck = rCheckCell.Value
If sCheck = sURL Then
itotal = itotal + rCheckCell.Offset(, 2).Value
rCell.Offset(, 2).Value = itotal
rCheckCell.EntireRow.Delete
End If
Next rCheckCell
Next rCell
End Sub