Block If without End If

[ipbr21054]

Morning,
Please can you check my code & advise what im missing.
Currently i get the RTE Block If without End If but i also believe there is another issue.

This works fine.

Private Sub AprilStartButton_Click()

If WorksheetFunction.CountA(Range("B4:B13")) > 0 Then
    answer = MsgBox("CELLS CONTAIN VALUES ALREADY, OVERWRITE THEM ?", vbCritical + vbYesNo)
    If answer = vbNo Then
        Exit Sub
    End If
End If
   
Range("I9:I18").Copy Destination:=Range("B4:B13")
MsgBox "ALL FIGURES HAVE BEEN TRANSFERED", vbInformation, "MONTHS FIGUES MESSAGE"
Unload SUMMARYSHEETYEAR
Range("I9:I18").ClearContents
Range("I9").Select

End Sub

The code above doesnt take into consideration that the range I9:I18 could be empty.
So the code continues to run & i then see the msgbox "All figures have been transfered.

So i added the extra code in red below to it to first check but then this is where i now fail for it to run correctly.

Private Sub AprilStartButton_Click()
If WorksheetFunction.CountA(Range("I9:I18")) = 0 Then
MsgBox "THERE ARE NO VALUES TO TRANSFER", vbCritical
Else

If WorksheetFunction.CountA(Range("B4:B13")) > 0 Then
    answer = MsgBox("CELLS CONTAIN VALUES ALREADY, OVERWRITE THEM ?", vbCritical + vbYesNo)
    If answer = vbNo Then
      Exit Sub
    End If
End If
   
Range("I9:I18").Copy Destination:=Range("B4:B13")
MsgBox "ALL FIGURES HAVE BEEN TRANSFERED", vbInformation, "MONTHS FIGUES MESSAGE"
Unload SUMMARYSHEETYEAR
Range("I9:I18").ClearContents
Range("I9").Select
ActiveWorkbook.Save

End Sub

 

[Jaafar Tribak]

How about replacing this :

If WorksheetFunction.CountA(Range("I9:I18")) = 0 Then
    MsgBox "THERE ARE NO VALUES TO TRANSFER", vbCritical
Else

With this:

    If WorksheetFunction.CountA(Range("I9:I18")) = 0 Then
        MsgBox "THERE ARE NO VALUES TO TRANSFER", vbCritical
        Exit Sub
    End If

 

[ipbr21054]

This works but please check it anyway

Thanks

Private Sub AprilStartButton_Click()
If WorksheetFunction.CountA(Range("I9:I18")) = 0 Then
MsgBox "THERE ARE NO VALUES TO TRANSFER", vbCritical

Else
If WorksheetFunction.CountA(Range("B4:B13")) > 0 Then
    answer = MsgBox("CELLS CONTAIN VALUES ALREADY, OVERWRITE THEM ?", vbCritical + vbYesNo)
    If answer = vbNo Then
      Exit Sub
    End If
End If
    
Range("I9:I18").Copy Destination:=Range("B4:B13")
MsgBox "ALL FIGURES HAVE BEEN TRANSFERED", vbInformation, "MONTHS FIGUES MESSAGE"
Unload SUMMARYSHEETYEAR
Range("I9:I18").ClearContents
Range("I9").Select
ActiveWorkbook.Save
End If

End Sub

 

[Jaafar Tribak]

This works but please check it anyway

Thanks

Private Sub AprilStartButton_Click()
If WorksheetFunction.CountA(Range("I9:I18")) = 0 Then
MsgBox "THERE ARE NO VALUES TO TRANSFER", vbCritical

Else
If WorksheetFunction.CountA(Range("B4:B13")) > 0 Then
    answer = MsgBox("CELLS CONTAIN VALUES ALREADY, OVERWRITE THEM ?", vbCritical + vbYesNo)
    If answer = vbNo Then
      Exit Sub
    End If
End If
   
Range("I9:I18").Copy Destination:=Range("B4:B13")
MsgBox "ALL FIGURES HAVE BEEN TRANSFERED", vbInformation, "MONTHS FIGUES MESSAGE"
Unload SUMMARYSHEETYEAR
Range("I9:I18").ClearContents
Range("I9").Select
ActiveWorkbook.Save
End If

End Sub

Thta should also work .

 

[ipbr21054]

Many thanks now sorted