assistance with for-next error

[Askalon]

I have a large macro setup that runs through a for next. It will not end! I can post the code here. I am very sure the code itself can be reworked to be smaller, but this is what I could come up with.

The goal is to find a range based on a start and end date, then by a property code and lastly, when that range is found, add up the hours and post to a seperate sheet. I have many properties to go through and many employee's to do this on.

Thanks for your help.

This is the first section, it would repeat further based on week 2 and week 3, etc... and then start all over with the next person.

Sub Seluser()
rng = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row

Dim w1sdate
Dim w1edate
Dim w2sdate
Dim w2edate
Dim w3sdate
Dim w3edate
Dim w4sdate
Dim w4edate
Dim w5sdate
Dim w5edate

w1sdate = InputBox("Please enter the start date of the 1st week", "Start Date")
w1edate = InputBox("Please enter the end date of the 1st week", "End Date")
'w2sdate = InputBox("Please enter the start date of the 2nd week", "Start Date")
'w2edate = InputBox("Please enter the end date of the 2nd week", "End Date")
'w3sdate = InputBox("Please enter the start date of the 3rd week", "Start Date")
'w3edate = InputBox("Please enter the end date of the 3rd week", "End Date")
'w4sdate = InputBox("Please enter the start date of the 4th week", "Start Date")
'w4edate = InputBox("Please enter the end date of the 4th week", "End Date")
'w5sdate = InputBox("Please enter the start date of the 5th week", "Start Date")
'w5edate = InputBox("Please enter the end date of the 5th week", "End Date")

Application.ScreenUpdating = False
Dim myLastRow As Long
Dim myLastColumn As Long
Range("A1").Select
 On Error Resume Next
' Find range based on the employee's name, this could be 
' done dynamic with a name=range("a1").value I think
    myLastRow = Cells.Find("Employee Name", [A1], , , xlByRows, xlPrevious).Row
    myLastColumn = Cells.Find("*", [A1], , , xlByColumns, xlPrevious).Column
    mylastcell = Cells(myLastRow, myLastColumn).Address
myRange = "a1:" & mylastcell
Range(myRange).Select
Selection.Cut
Sheets.add Type:="Worksheet"
    With ActiveSheet
        .Name = "Employee Name"  'this is based on the name that is staticly placed above
    End With
    Range("A1").Select
    ActiveSheet.Paste

Range("A1").Select
 On Error Resume Next
    myLastRow = Cells.Find(w1edate, [A1], , , xlByRows, xlPrevious).Row
    myLastColumn = Cells.Find("*", [A1], , , xlByColumns, xlPrevious).Column
    mylastcell = Cells(myLastRow, myLastColumn).Address
myRange = "a1:" & mylastcell

Range(myRange).Select
Selection.Cut
Sheets.add Type:="Worksheet"
    With ActiveSheet
        .Name = "week1"
    End With
    Range("A1").Select
    ActiveSheet.Paste


With Selection
.sort Key1:=Range("D1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortTextAsNumbers
End With
Range("a1").Select
wk1rng = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row

For i = 1 To wk1rng
Range("a1").Select
Name = Range("a1").Value
property = Range("d1").Value
Range("A1").Select
   myLastRow = Cells.Find(property, [A1], , , xlByRows, xlPrevious).Row
    myLastColumn = Cells.Find("*", [A1], , , xlByColumns, xlPrevious).Column
    mylastcell = Cells(myLastRow, myLastColumn).Address
myRange = "a1:" & mylastcell
Application.ScreenUpdating = True
Range(myRange).Select
Selection.Cut
Sheets.add Type:="Worksheet"
    With ActiveSheet
        .Name = "hours"
    End With
    Range("A1").Select
    ActiveSheet.Paste
With Selection
 Range("F1").Value = Application.WorksheetFunction.Sum([b:b])
 End With
 hours = Range("F1").Value
 
 Sheets("finish").Select
 Range("A1").Select
 On Error Resume Next
   myLastRow = Cells.Find(Name, [A1], , , xlByRows, xlPrevious).Row
    myLastColumn = Cells.Find(property, [A1], , , xlByColumns, xlPrevious).Column
    mylastcell = Cells(myLastRow, myLastColumn).Address
    Range(mylastcell).Value = hours
    
    Application.DisplayAlerts = False
    Sheets(hours).Delete
    Application.DisplayAlerts = True

    Sheets("week1").Select
With Application
        .Calculation = xlCalculationManual
      
    'We work backwards because we are deleting rows.
    For j = Selection.Rows.Count To 1 Step -1
        If WorksheetFunction.CountA(Selection.Rows(j)) = 0 Then
            Selection.Rows(j).EntireRow.Delete
        End If
    Next j

        .Calculation = xlCalculationAutomatic
    End With
 
Next i