简体   繁体   中英

Runtime error in VBA Excel

I am comparing two column D and E in my sheet which are containing Dates. The column E has date and sometime there are no Dates and sometime it has X, in the row. I get an runtime error

type mismatch

Could anyone suggest what is wrong with my code. ?

Sub datecompare()

    Dim ws As Worksheet
    Dim lRow As Long, i As Long
    Dim zWeeks As Double, zcolour As Long                 
    Dim Ztext As String

    Set ws = Sheets("Preparation Sheet")

    With ws
        lRow = .range("D" & .Rows.Count).End(xlUp).Row    
        For i = 2 To lRow
            zWeeks = DateDiff("ww", .range("E" & i).Value, .range("D" & i).Value)    
            If .range("A" & i).Value <> "" And .range("B" & i).Value <> "" And .range("E" & i).Value = "" Then
                Ztext = "remaining"
                zcolour = vbYellow
                Cells(i, 7) = "Yellow"
            ElseIf .range("B" & i).Value = "" And .range("E" & i).Value = "" Then
                GoTo nextrow
            ElseIf zWeeks < 4 Then
                Ztext = " on time"
                zcolour = vbGreen
                Cells(i, 7) = "Green"
            ElseIf zWeeks > 8 Then
                Ztext = " delayed"
                zcolour = vbRed
                Cells(i, 7) = "Red"
            ElseIf zWeeks > 4 < 8 Then
                Ztext = "remaining"
                zcolour = vbYellow
                Cells(i, 7) = "Yellow"
            End If

            With .range("F" & i)
                .Value = Ztext
                .Interior.Color = zcolour
            End With
nextrow:
        Next i
    End With

End Sub

The error occurs at GoTo nextrow

and it jumps to next, without running through the in between code.

I think, the code woult to be like this.

Sub datecompare()

    Dim ws As Worksheet
    Dim lRow As Long, i As Long
    Dim zWeeks As Double, zcolour As Long
    Dim Ztext As String

    Set ws = Sheets("Preparation Sheet")
    'Cells.Interior.Color = xlNone
    With ws
        lRow = .Range("D" & .Rows.Count).End(xlUp).Row
        For i = 2 To lRow
            If IsDate(.Range("E" & i).Value) And IsDate(.Range("D" & i).Value) Then
            Else
                GoTo nextrow
            End If
            zWeeks = DateDiff("ww", .Range("E" & i).Value, .Range("D" & i).Value)
            If .Range("A" & i).Value <> "" And .Range("B" & i).Value <> "" And .Range("E" & i).Value = "" Then
                Ztext = "remaining"
                zcolour = vbYellow
                Cells(i, 7) = "Yellow"

            Else '<~~ .Range("A" & i).Value <> "" And .Range("B" & i).Value <> "" And .Range("E" & i).Value = ""  true or false , this is false
                If .Range("B" & i).Value = "" And .Range("E" & i).Value = "" Then
                    GoTo nextrow
                Else '<~~ .Range("B" & i).Value = "" And .Range("E" & i).Value = "" Then  true or false, this is false
                    '<~~ When the result is false,  after code applied
                    If zWeeks < 4 Then
                        Ztext = " on time"
                        zcolour = vbGreen
                        Cells(i, 7) = "Green"
                    ElseIf zWeeks > 8 Then
                        Ztext = " delayed"
                        zcolour = vbRed
                        Cells(i, 7) = "Red"
                    ElseIf zWeeks >= 4 And zWeeks <= 8 Then
                        Ztext = "remaining"
                        zcolour = vbYellow
                        Cells(i, 7) = "Yellow"
                    End If
                End If
            End If
            With .Range("F" & i)
                .Value = Ztext
                .Interior.Color = zcolour
            End With
nextrow:
        Next i
    End With

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