Eliminate Duplicate Rows - Add columns Accordingly

[meendar]

Hi anyone helpme to sort out this problem.

I have an Excel sheet with names in Column A, Hours in Column B and
Amount in Column C. What my question is i want to eliminate the
duplicate rows in Column A , mean while B and C should be added to the
unique user row. Is there any macro for that?

Thanks in Advance.

 

[Bob Phillips]

Sub CreateSummary()
Dim iLastRow As Long
Dim i As Long
Dim iRow As Long

iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = iLastRow To 2 Step -1
iRow = Application.Match(Cells(i, "A").Value, Columns(1), 0)
If iRow < i Then
Cells(iRow, "B").Value = Cells(iRow, "B").Value + Cells(i,
"B").Value
Cells(iRow, "C").Value = Cells(iRow, "C").Value + Cells(i,
"C").Value
Rows(i).Delete
End If
Next i

End Sub


--
HTH

Bob Phillips

(remove nothere from email address if mailing direct)