Move to next row and repeat

[eviehc123]

Hi,

How can I edit this code to repeat the check on the next row? I would like the code to check ranges B3:B9, B12:B18, B21:B27, B30:B36, L3:L9 before closing to ensure that the user cannot close the form before editing all cells.

I should note that usually only one row will be completed at a time before closing.

Thanks!

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    If ActiveSheet.Range("B3") <> "" And _
    ActiveSheet.Range("C3") = "" And _
    ActiveSheet.Range("D3") = "" And _
    ActiveSheet.Range("E3") = "" And _
    ActiveSheet.Range("F3") = "" And _
    ActiveSheet.Range("G3") = "" And _
    ActiveSheet.Range("H3") = "" Then
        Cancel = True
        MsgBox "All cells must be completed"
    Else
        ActiveWorkbook.Close SaveChanges:=True
    End If
End Sub

 

[eviehc123]

Hi thank you. I have placed both codes in Thisworkbook. However, it will not let me close even if a whole row has been completed? I want it to save close after one row has been completed if possible.

 

[dmt32]

Hi thank you. I have placed both codes in Thisworkbook. However, it will not let me close even if a whole row has been completed? I want it to save close after one row has been completed if possible.

That's what updated function should do. The function will highlight the row that is only part completed.
check all cells in your defined range to ensure they are clear.

If still having issues then if possible, place copy of your workbook in a dropbox & provide a link to it here.

Dave

 

[eviehc123]

Hi Dave,

Thank you the link is below:

https://www.dropbox.com/s/145if37o7bddpst/DBS Diary- February 19 onwards.xlsm?dl=0

Thanks!

 

[dmt32]

Hi,
Two things

1 - you have the function in Module 1 & ThisworkBook Module - delete them BOTH

2 - Replace in either location the following updated function

Function IsNotComplete() As Boolean
    Dim Cell As Range, Rng As Range
    Dim Target As Range
    
    Set Target = Range("B3:B9,B12:B18,B21:B27,B30:B36,L3:L9")
    
    For Each Cell In Target.Cells
        Set Rng = Cell.Resize(, 7)


        With Application
            If .CountIf(Rng, ">""") Then
                IsNotComplete = CBool(.CountA(Rng) <> Rng.Cells.Count)
            End If
        End With
        
        If IsNotComplete Then
            MsgBox "All cells must be completed", 48, "Entry Required"
            Rng.Select
            Exit Function
        End If
        Set Rng = Nothing
    Next Cell
End Function

What you did not mention is that some cells in your ranges have formulas which were being counted as an entry even though cell showing blank.

Hopefully, updated version will resolve.

Dave

 

[eviehc123]

Hi sorry about that!

Now works perfectly, thank you for your help.

Eve

 

[dmt32]

Hi sorry about that!

Now works perfectly, thank you for your help.

Eve

No worries glad we managed to resolve

Many thanks for feedback

Dave