VBA to total hours on specific criteria

[carlleese24]

Hi

On the file I have 2 sheets one is Hours with the following titles at row 1

Employee (A)
Hours (B)
£ per hours (C)
Date (D)

The other sheet is called Summary with the following titles at row 5
Name (A)
Hours worked (B)


I also have cells for dates which on cells C2 (start date) and D2 (end date) so users can type in a date and press a button so they can sum up the data in any date range and put the total hours for each person as the vba goes down the list of names on the summary tab and for for those dates


Start date
End date
Name

The vba goes down the list of names on the summary tab it will looks for the name on each row and the start and end date it will then total the hours on the hours sheet that match this criteria and put the total next to each name

the ranges for names and hours can change and also the number of rows will reach about 65,000.


Please could anyone help me to make this possible.

Carl

 

[carlleese24]

I have manage to create the code for it see below

Sub Total_Hours()


Dim wshours As Worksheet, wsSummary As Worksheet
Dim Lastrow&, i&, j&
Dim Total_Hours_worked, Hours, Summary, Hours_worked As Double
Dim Employee_name_Summary, Employee_name_Hours As String



Dim Start_date, end_date, Hour_date As Date

Set wshours = Sheets("Hours")
Set wsSummary = Sheets("Summary")


Lastrow = wshours.Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row
Hours = wshours.Range("A2:d" & Lastrow)

Lastrow = wsSummary.Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row
Summary = wsSummary.Range("A6:f" & Lastrow)



For i = 6 To UBound(Summary, 1) + 5
Employee_name_Summary = wsSummary.Cells(i, 1)
Start_date = Sheets("Summary").Range("c2")
end_date = Sheets("Summary").Range("d2")


For j = 2 To UBound(Hours, 1) + 1
Employee_name_Hours = wshours.Cells(j, 1)
Hours_worked = wshours.Cells(j, 2)
Hour_date = wshours.Cells(j, 4)

If Employee_name_Summary = Employee_name_Hours And end_date >= Hour_date And Start_date <= Hour_date Then

Total_Hours_worked = Total_Hours_worked + Hours_worked

End If
Next j


wsSummary.Cells(i, 2) = Total_Hours_worked
Total_Hours_worked = 0

Next i
End Sub


Please could anyone make this code more efficient and faster