How to incorporate a Do Until Loop with code that is already counting other things Excel VBA

Question

I have a macro that looks at a full list of scheduled tasks on one worksheet in the workbook (Task Worksheet), and when you run it each morning, writes that particular day's required tasks to another worksheet (Schedule worksheet). The macro runs fine. However, I've used a count of i = 1 to 60 to loop the search for matching criteria. I'd far prefer to use a more elegant Do until activecell isblank type solution, but I'm having a very hard time wrapping my head around the structure and sytax that I'd need to make all the moving parts play together. I've looked here and on many other sites, and found many good examples of the code, but am unsure of how to write it to interact with the code I've already got.

Can anyone help?

Here's my current code: (as you can see, it's very repetitive, so if someone could show me how to structure one of the subs, it would sort my entire macro out)

Sub Schedule()
'
' Schedule Macro
' Pulls all the Daily, weekly by day of the week and monthly by date reports from the task sheet and writes them to the schedule worksheet.
' First writes the Daily reports then uses the day/date to decide which other subs to run
'
' Keyboard Shortcut: Ctrl+Shift+S
'

Dim i As Integer

Dim erow As Integer

Dim z As Integer

For i = 1 To 60 'Arbitrary until I get bettere at Do While Loops

If Sheets("Tasks").Range("E" & i) = "Daily" Then

erow = Sheets("Schedule").Range("A10000").End(xlUp).Row + 1 

'10000 is just a large number that is somewhat bigger than you would possibly expect the last cell of data to appear at.

For z = 1 To 6 'loop round to directly push the 6 pieces of data to the other sheet

Sheets("Schedule").Cells(erow, z) = Sheets("Tasks").Cells(i, z)

Next z

     End If 

Next i

' Checking to see if it's Monday and running that Sub if it is.

If Weekday(Now()) = vbMonday Then

Call Monday

End If

' Checking to see if it's Tuesday and running that Sub if it is.

If Weekday(Now()) = vbTuesday Then

    Call Tuesday

End If

' Checking to see if it's Wednesday and running that Sub if it is.

If Weekday(Now()) = vbWednesday Then

    Call Wednesday

End If

' Checking to see if it's Thursday and running that Sub if it is.

If Weekday(Now()) = vbThursday Then

    Call Thursday

End If

' Checking to see if it's Friday and running that Sub if it is.

If Weekday(Now()) = vbFriday Then

    Call Friday

End If


    Call Dates



Sub Monday()
'
' Sort Macro
' Copies and pasts rows from the Tasks worksheet over to the Schedule worksheet based on Criteria in Column E Being a Monday Report
'

Dim i As Integer

Dim erow As Integer

Dim z As Integer

For i = 1 To 60 

'Arbitrary until I get bettere at Do While Loops

    If Sheets("Tasks").Range("E" & i) = "Monday" Then

        erow = Sheets("Schedule").Range("A10000").End(xlUp).Row + 1

 '10000 is just a large number that is somewhat bigger than you would possibly expect the last cell of data to appear at.

        For z = 1 To 6

 'loop round to directly push the 6 pieces of data to the other sheet

            Sheets("Schedule").Cells(erow, z) = Sheets("Tasks").Cells(i, z)

        Next z

    End If

Next i

End Sub

Sub Tuesday()
'
' Sort Macro

' Copies and pasts rows from the Tasks worksheet over to the Schedule worksheet based on Criteria in Column E Being a Tuesday Report
'

Dim i As Integer

Dim erow As Integer

Dim z As Integer

For i = 1 To 60 

'Arbitrary until I get bettere at Do While Loops

    If Sheets("Tasks").Range("E" & i) = "Tuesday" Then

        erow = Sheets("Schedule").Range("A10000").End(xlUp).Row + 1

 '10000 is just a large number that is somewhat bigger than you would possibly expect the last cell of data to appear at.

        For z = 1 To 6 'loop round to directly push the 6 pieces of data to the other sheet

            Sheets("Schedule").Cells(erow, z) = Sheets("Tasks").Cells(i, z)

        Next z

    End If

Next i

End Sub

Sub Wednesday()
'
' Sort Macro
' Copies and pasts rows from the Tasks worksheet over to the Schedule worksheet based on Criteria in Column E Being a Wednesday Report
'

Dim i As Integer

Dim erow As Integer

Dim z As Integer

For i = 1 To 60

 'Arbitrary until I get bettere at Do While Loops

    If Sheets("Tasks").Range("E" & i) = "Wednesday" Then

        erow = Sheets("Schedule").Range("A10000").End(xlUp).Row + 1 

'10000 is just a large number that is somewhat bigger than you would possibly expect the last cell of data to appear at.

        For z = 1 To 6 

'loop round to directly push the 6 pieces of data to the other sheet

            Sheets("Schedule").Cells(erow, z) = Sheets("Tasks").Cells(i, z)

        Next z

    End If

Next i

End Sub

Sub Thursday()
'
' Sort Macro
' Copies and pasts rows from the Tasks worksheet over to the Schedule worksheet based on Criteria in Column E Being a Thursday Report
'

Dim i As Integer

Dim erow As Integer

Dim z As Integer

For i = 1 To 60 

'Arbitrary until I get bettere at Do While Loops

    If Sheets("Tasks").Range("E" & i) = "Thursday" Then

        erow = Sheets("Schedule").Range("A10000").End(xlUp).Row + 1 

'10000 is just a large number that is somewhat bigger than you would possibly expect the last cell of data to appear at.

        For z = 1 To 6 

'loop round to directly push the 6 pieces of data to the other sheet

            Sheets("Schedule").Cells(erow, z) = Sheets("Tasks").Cells(i, z)

        Next z

    End If

Next i

End Sub

Sub Friday()
'
' Sort Macro
' Copies and pasts rows from the Tasks worksheet over to the Schedule worksheet based on Criteria in Column E Being a Friday Report
'

Dim i As Integer

Dim erow As Integer

Dim z As Integer

For i = 1 To 60 

'Arbitrary until I get bettere at Do While Loops

    If Sheets("Tasks").Range("E" & i) = "Friday" Then

        erow = Sheets("Schedule").Range("A10000").End(xlUp).Row + 1 

'10000 is just a large number that is somewhat bigger than you would possibly expect the last cell of data to appear at.

        For z = 1 To 6 

'loop round to directly push the 6 pieces of data to the other sheet

            Sheets("Schedule").Cells(erow, z) = Sheets("Tasks").Cells(i, z)

        Next z

    End If

Next i

End Sub

Sub Dates()
'
' Sort Macro
' Copies and pasts rows from the Tasks worksheet over to the Schedule worksheet based on Criteria in Column E Being Date
'

Dim i As Integer

Dim erow As Integer

Dim z As Integer

For i = 1 To 60 

'Arbitrary until I get bettere at Do While Loops

    If Sheets("Tasks").Range("E" & i) = Date Then

        erow = Sheets("Schedule").Range("A10000").End(xlUp).Row + 1 

'10000 is just a large number that is somewhat bigger than you would possibly expect the last cell of data to appear at.

        For z = 1 To 6 

'loop round to directly push the 6 pieces of data to the other sheet

            Sheets("Schedule").Cells(erow, z) = Sheets("Tasks").Cells(i, z)

        Next z

    End If

Next i

End Sub

Kind regards,

Jeb

For loops are better as they have a definite end. You need to find the last row with data and set the end of the for loop to that. to find the last row see here: https://stackoverflow.com/questions/11169445/error-in-finding-last-used-cell-in-vba — Scott Craner, Feb 15 '18 at 19:27
You already find the last row on the other sheet, just use that same idea to limit the loops. — Scott Craner, Feb 15 '18 at 19:28

How to incorporate a Do Until Loop with code that is already counting other things Excel VBA

0 Answers0