Hello Kam
Give this a try. It is not the best macro but it'll do the job. If you
have a lot of rows on your worksheet, it will be faster with
application.screenupdating=false before the first For and
application.screenupdating=true as the last line before End Sub

Sub EmptyRow()
Dim cou As Integer, MPStr As String, MPString As String, usd, gbp,
cou1, twice
For twice = 0 To 1
Range("a1:c1").Copy Range("e1:g1")
cou1 = 2
For cou = 2 To ActiveSheet.UsedRange.Rows.Count - 1
ActiveSheet.Cells(cou1, 5) = ActiveSheet.Cells(cou, 1)
ActiveSheet.Cells(cou1, 6) = ActiveSheet.Cells(cou, 2)
ActiveSheet.Cells(cou1, 7) = ActiveSheet.Cells(cou, 3)

usd = usd + ActiveSheet.Cells(cou, 2)
gbp = gbp + ActiveSheet.Cells(cou, 3)

MPStr = Format(ActiveSheet.Cells(cou, 1), "YY")
MPString = Format(ActiveSheet.Cells(cou + 1, 1), "YY")
cou1 = cou1 + 1
If Not Val(MPString) = Val(MPStr) Then
If cou < ActiveSheet.UsedRange.Rows.Count Then
ActiveSheet.Cells(cou1, 6) = usd
ActiveSheet.Cells(cou1, 7) = gbp
Else
ActiveSheet.Cells(ActiveSheet.UsedRange.Rows.Count + 1, 6) = usd
ActiveSheet.Cells(ActiveSheet.UsedRange.Rows.Count + 1, 7) = gbp

End If
cou1 = cou1 + 1
usd = 0: gbp = 0
End If
Next
Next
Columns("a:d").Select
Selection.Delete Shift:=xlToLeft
Range("a2").Select
End Sub


*** Sent via Developersdex http://www.developersdex.com ***