VBA Unique Sum Code - vba

Question

I have Surnames in Column A, First Names in Column B, Dates in Column C and Hours worked in Column D.
E.G.
Surname First Name Date Hours
COX Daniel 3/03/2015 6
COX Daniel 3/03/2015 4
COX Daniel 4/03/2015 3.5
COX Daniel 4/03/2015 4
COX Daniel 4/03/2015 2.5
COX Daniel 4/03/2015 0
I would like to sum the number of hours each person has worked each day into a new sheet.
Surname First Name Date Hours
COX Daniel 3/03/2015 10
COX Daniel 4/03/2015 10
I have a code that works, however, it is very longwinded and would like to see how I can improve my coding. My code is also limited by the number of entries on a specific date (I have done up to 6 entries); there could be more.
Sub WorkHours()
Application.ScreenUpdating = False
Dim R As Integer
For R = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
'Sort Data by Date and then by Surname
Sheets("Sheet1").Select
Worksheets("Sheet1").Columns("A:N").Sort key1:=Range("C2"), order1:=xlAscending, Header:=xlYes
Worksheets("Sheet1").Columns("A:N").Sort key1:=Range("A2"), order1:=xlAscending, Header:=xlYes
'Sum Work Hours for One Day
Worksheets("Sheet1").Select
If Range("C" & R) = Range("C" & (R + 1)) And Range("C" & R + 1) = Range("C" & (R + 2)) And Range("C" & R + 2) = Range("C" & (R + 3)) And Range("C" & R + 3) = Range("C" & (R + 4)) And Range("C" & R + 4) = Range("C" & (R + 5)) And Range("C" & R + 5) <> Range("C" & (R + 6)) Then
Range("C" & R).Select
ActiveCell.Offset(5, 2) = Application.Sum(Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(5, 1)))
End If
If Range("C" & R) = Range("C" & (R + 1)) And Range("C" & R + 1) = Range("C" & (R + 2)) And Range("C" & R + 2) = Range("C" & (R + 3)) And Range("C" & R + 3) = Range("C" & (R + 4)) And Range("C" & R + 4) <> Range("C" & (R + 5)) Then
Range("C" & R).Select
ActiveCell.Offset(4, 2) = Application.Sum(Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(4, 1)))
End If
If Range("C" & R) = Range("C" & (R + 1)) And Range("C" & R + 1) = Range("C" & (R + 2)) And Range("C" & R + 2) = Range("C" & (R + 3)) And Range("C" & R + 3) <> Range("C" & (R + 4)) Then
Range("C" & R).Select
ActiveCell.Offset(3, 2) = Application.Sum(Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(3, 1)))
End If
If Range("C" & R) = Range("C" & (R + 1)) And Range("C" & R + 1) = Range("C" & (R + 2)) And Range("C" & R + 2) <> Range("C" & (R + 3)) Then
Range("C" & R).Select
ActiveCell.Offset(2, 2) = Application.Sum(Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(2, 1)))
End If
If Range("C" & R) = Range("C" & (R + 1)) And Range("C" & R + 1) <> Range("C" & (R + 2)) Then
Range("C" & R).Select
ActiveCell.Offset(1, 2) = Application.Sum(ActiveCell.Offset(0, 1), ActiveCell.Offset(1, 1))
End If
If Range("C" & R) <> Range("C" & (R + 1)) Then
Range("C" & R).Select
ActiveCell.Offset(0, 2) = ActiveCell.Offset(0, 1)
End If
Next R
'Copy Sheet
Sheets("Sheet1").Columns(1).Copy Destination:=Sheets("Sheet2").Columns(1)
Sheets("Sheet1").Columns(2).Copy Destination:=Sheets("Sheet2").Columns(2)
Sheets("Sheet1").Columns(3).Copy Destination:=Sheets("Sheet2").Columns(3)
Sheets("Sheet1").Columns(5).Copy Destination:=Sheets("Sheet2").Columns(4)
'Delete Empty Hours Columns
Sheets("Sheet2").Select`
On Error Resume Next
Columns("D").SpecialCells(xlCellTypeBlanks).EntireRow.Delete`
'AutoFit Columns
Cells.Select
Cells.EntireColumn.AutoFit
Application.ScreenUpdating = True
End Sub

Answer 1

You should name your range of cells. You should then save your workbook, and click
Data>From Other Sources>From Microsoft Query
You should then select Excel Files, Ok, then navigate to your Excel file. You should select your range, then click Ok. Then, drop in the following SQL statement, updated for your range
SELECT Values.Surname, Values.[First Name], Values.Date, SUM(Values.Hours) _
FROM Values Value GROUP BY Values.Surname, Values.[First Name], Values.Date