Simple VBA code stalling on END IF?

[30136353]

I have a fairly simple code to copy some cells down after a countif = 0, but some reason this just stalls and when i hit escape it throws an error to the end if?

    Sub NewSpineTable()
    
    Dim I As Long, LR As Long
    
    I = 2
    
    Do While Worksheets("Network Data").Cells(I, 14) <> ""
    
    
    LR = Worksheets("Spine Summary").Range("E" & Rows.Count).End(xlUp).Row
    
    If Application.WorksheetFunction.CountIf(Worksheets("Spine Summary").Range("D2:D" & LR), Worksheets("Network Data").Cells(I, 14) = 0) Then

    MsgBox "TRUE"

    LR = Worksheets("Spine Summary").Range("E" & Rows.Count).End(xlUp).Row + 1
    Worksheets("Spine Summary").Range("A2:T3").Copy Worksheets("Spine Summary").Range("A" & LR)
    Worksheets("Spine Summary").Range("A:" & LR & ":C" & LR + 1).ClearContents
    I = I + 1
    End If
    
    Loop

    End Sub

 

[RoryA]

If your countif is not 0, then I never gets incremented and you will be stuck in an endless loop.

 

[30136353]

If your countif is not 0, then I never gets incremented and you will be stuck in an endless loop.

ahhhh yeh that makes sense, how do i position the "Else" and "End if", so if the countif = 0 that it just loops onto the next I? Then after it continues the overall loop? Thanks for the help

    Sub NewSpineTable()
    
    Dim I As Long, LR As Long
    
    I = 2
    
    Do While Worksheets("Network Data").Cells(I, 14) <> ""

    If Application.WorksheetFunction.CountIf(Worksheets("Spine Summary").Range("D:D"), Worksheets("Network Data").Cells(I, 14) = 0) Then
    
    LR = Worksheets("Spine Summary").Range("E" & Rows.Count).End(xlUp).Row + 1
    Worksheets("Spine Summary").Range("A2:T3").Copy Worksheets("Spine Summary").Range("A" & LR)
    Worksheets("Spine Summary").Range("A:" & LR & ":C" & LR + 1).ClearContents
    Else
    I = I + 1

    End If

    Loop

    End Sub

 

[RoryA]

The I = I + 1 should be after the End If since you always want to move on to the next cell. Personally, I'd prefer to get the last row (using the same End(xlup) technique you used for LR and then just loop from 2 to that row without the Do While.

 

[30136353]

The I = I + 1 should be after the End If since you always want to move on to the next cell. Personally, I'd prefer to get the last row (using the same End(xlup) technique you used for LR and then just loop from 2 to that row without the Do While.

Thanks, I still can't seem to it to work. If i remove the IF statement it works how it should, but Column D:D on spine summary has duplicates hence the additional IF statement. Any Idea? When I run the below code it just completes without doing anything, because the first countif does not = 0.

    Sub NewSpineTable()
    
    Dim I As Long, LR As Long
    
    I = 2
    
    
    Do While Worksheets("Network Data").Cells(I, 14) <> ""

    If Application.WorksheetFunction.CountIf(Worksheets("Spine Summary").Range("D:D"), Worksheets("Network Data").Cells(I, 14) = 0) Then

    LR = Worksheets("Spine Summary").Range("E" & Rows.Count).End(xlUp).Row + 1
    Worksheets("Spine Summary").Range("A2:U3").Copy Worksheets("Spine Summary").Range("A" & LR)
    Worksheets("Spine Summary").Range("A" & LR & ":C" & LR + 1).ClearContents
    Worksheets("Spine Summary").Range("A" & LR & ":A" & LR + 1).Value = Worksheets("Network Data").Cells(I, 1)
    Worksheets("Spine Summary").Range("B" & LR & ":B" & LR + 1).Value = Worksheets("Network Data").Cells(I, 6)
    Worksheets("Spine Summary").Range("C" & LR & ":D" & LR + 1).Value = Worksheets("Network Data").Cells(I, 9)
    Worksheets("Spine Summary").Range("D" & LR & ":D" & LR + 1).Value = Worksheets("Network Data").Cells(I, 14)
    
    Else
       
    I = I + 1
    
    End If

    Loop

    MsgBox "All Spines Added!"
    
    End Sub

 

[RoryA]

As I said, the I = I + 1 needs to be after the End If, not inside the If clause.

 

[30136353]

y

As I said, the I = I + 1 needs to be after the End If, not inside the If clause.

yeh ive tried that still doesnt get paste the first iteration where the countif does not 0

 

[RoryA]

Please post what you tried.

 

[30136353]

Please post what you tried.

    Sub NewSpineTable()
    
    Dim I As Long, LR As Long
    
    I = 2
    
    
    Do While Worksheets("Network Data").Cells(I, 14) <> ""

    If Application.WorksheetFunction.CountIf(Worksheets("Spine Summary").Range("D:D"), Worksheets("Network Data").Cells(I, 14) = 0) Then

    LR = Worksheets("Spine Summary").Range("E" & Rows.Count).End(xlUp).Row + 1
    Worksheets("Spine Summary").Range("A2:U3").Copy Worksheets("Spine Summary").Range("A" & LR)
    Worksheets("Spine Summary").Range("A" & LR & ":C" & LR + 1).ClearContents
    Worksheets("Spine Summary").Range("A" & LR & ":A" & LR + 1).Value = Worksheets("Network Data").Cells(I, 1)
    Worksheets("Spine Summary").Range("B" & LR & ":B" & LR + 1).Value = Worksheets("Network Data").Cells(I, 6)
    Worksheets("Spine Summary").Range("C" & LR & ":D" & LR + 1).Value = Worksheets("Network Data").Cells(I, 9)
    Worksheets("Spine Summary").Range("D" & LR & ":D" & LR + 1).Value = Worksheets("Network Data").Cells(I, 14)
    
    Else
    End If
    
       
    I = I + 1

    Loop

    MsgBox "All Spines Added!"
    
    End Sub

 

[RoryA]

Just noticed you have a bracket in the wrong place in the Countif line - it should be:

If Application.WorksheetFunction.CountIf(Worksheets("Spine Summary").Range("D:D"), Worksheets("Network Data").Cells(I, 14)) = 0 Then