简体   繁体   中英

Loop without do error, excel vba

I'm trying to read a macro that will sum up corresponding values associated with a series of dates. IE- Jan. 1st will have 20 rows, with corresponding entries of 20, 50, 80, in respective columns. I want a macro that will sum all of these entries, and once all of the Jan. 1st entries are summed, then it will move on to Jan. 2nd, and sum all of those entries. The code that I have written so far gives me a loop without do error.

Private Sub CommandButton1_Click()

Dim dateCheck As String
Dim shipDay As Date
Dim L As Integer
Dim i As Integer
Dim S As Integer
Dim search As String
Dim usaTotal As Long
Dim usaCredit As Long
Dim usaDebit As Long


L = 10
i = 3


dateCheck = InputBox("What Date is Ship Day 1?", "Ship Day Entry")

If IsDate(dateCheck) Then shipDay = DateValue(dateCheck) _
Else: MsgBox ("Invalid Date") ' Prompts user for ship day 1, and checks if actual date




While Not Worksheets("Sheet1").Cells(i, 8).Value = "" ' Runs until all cell rows are accounted for

For S = 0 To 29

shipDay = shipDay + S

Do Until shipDay <> Worksheets("Sheet1").Cells(i, 8).Value ' Execute until new date

search = Worksheets("sheet1").Cells(i, 12).Value ' Variable to use InStr to check for "CAN"

If (((shipDay = Worksheets("Sheet1").Cells(i, 8).Value) And _
InStr(1, search, "CAN", vbBinaryCompare) = 0) _
And (Worksheets("Sheet1").Cells(i, 6).Text = "Invoice")) Then

'Check that date matches, and that it isn't Canada, and that order is an invoice

usaDebit = Worksheets("Sheet1").Cells(i, 22).Value ' Account for Debits
usaCredit = Worksheets("Sheet1").Cells(i, 24).Value ' Account for Credits

usaTotal = usaTotal + usaCredit - usaDebit  ' Calculate contribution

i = i + 1

End If

Loop

MsgBox (usaTotal)


Next S

Worksheets("JUNE Canada").Cells(i, 22).Value = usaTotal

MsgBox (usaTotal)

 ' Need code here that will input final usaTotal into respective space

MsgBox (usaTotal)

Wend ' End of Initial "while not"

End Sub

Looks like you're missing an "end if" statement at the top. This seemed to work for me (I also added an "Exit Sub" if they inputted an invalid date. That just seemed to make sense, but you should take it out if an invalid date doesn't impact the rest of the code):

Private Sub CommandButton1_Click()

    Dim dateCheck As String
    Dim shipDay As Date
    Dim L As Integer
    Dim i As Integer
    Dim S As Integer
    Dim search As String
    Dim usaTotal As Long
    Dim usaCredit As Long
    Dim usaDebit As Long

    L = 10
    i = 3

    dateCheck = InputBox("What Date is Ship Day 1?", "Ship Day Entry")

    If IsDate(dateCheck) Then
        shipDay = DateValue(dateCheck)
    Else:
        MsgBox ("Invalid Date")
        Exit Sub
    End If ' Prompts user for ship day 1, and checks if actual date

    While Not Worksheets("Sheet1").Cells(i, 8).Value = "" ' Runs until all cell rows are accounted for

        For S = 0 To 29
            shipDay = shipDay + S
            Do Until shipDay <> Worksheets("Sheet1").Cells(i, 8).Value ' Execute until new date

                search = Worksheets("sheet1").Cells(i, 12).Value ' Variable to use InStr to check for "CAN"

                If (((shipDay = Worksheets("Sheet1").Cells(i, 8).Value) And _
                InStr(1, search, "CAN", vbBinaryCompare) = 0) _
                And (Worksheets("Sheet1").Cells(i, 6).Text = "Invoice")) Then

                'Check that date matches, and that it isn't Canada, and that order is an invoice

                usaDebit = Worksheets("Sheet1").Cells(i, 22).Value ' Account for Debits
                usaCredit = Worksheets("Sheet1").Cells(i, 24).Value ' Account for Credits

                usaTotal = usaTotal + usaCredit - usaDebit  ' Calculate contribution

                i = i + 1

                End If

            Loop

            MsgBox (usaTotal)
        Next S

        Worksheets("JUNE Canada").Cells(i, 22).Value = usaTotal
        MsgBox (usaTotal)

         ' Need code here that will input final usaTotal into respective space

        MsgBox (usaTotal)

    Wend ' End of Initial "while not"
End Sub

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM