popup message when mandatory columns are not filled in a row

[Mirzad]

Hi, I'm fresher in vba ,This particular excel is meant to be put in a share folder where team members are supposed to fill it. I want to popup a error message before saving. The requirements are
1.In a row , the highlighted columns must be filled(error msg before save if not filled)
2.select the empty cell to be filled.
3.If more than one mandatory cell is empty, select the first one.
4.No action for other columns(Non-Highlighted)enter image description here Thanks in Advance. I tried modifying different codes in this site, but I failed, Please help.

 

[Scott T]

Put this in the thisworkbook module.
change the sheet name and range to match you data and add elseif to the second if statement as need.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

If Application.WorksheetFunction.CountA(Worksheets("sheet1").Range("B2,B3,B4")) < 3 Then
    MsgBox "Workbook will not be saved unless" & vbCrLf & "All required fields have been filled in!"
      Cancel = True
End If


If Worksheets("Sheet1").Range("B2") = "" Then
    Worksheets("Sheet1").Range("B2").Select
ElseIf Worksheets("Sheet1").Range("B3") = "" Then
    Worksheets("Sheet1").Range("B3").Select
Else
    Worksheets("Sheet1").Range("B4").Select
End If


End Sub

 

[Mirzad]

Thanks a lot scott for your valuable time,
Your code helped me lot...
But can you give me suggestion for extending this code to "entire column(from 1st cell to last filled cell)" instead of specific cells like B2,B3,B4...
Because this excel's rows keep on increasing when new people add details, so it is almost impossible to mention every cell in a column in elseif condition.

NAME	ID	Phn No	Age
Matt	123	9876	25
Martin	456		29
	321	6789	56
Daisy		5432	22

<tbody>
</tbody>

for eg:- In this table "Name & PhnNo" are mandatory columns.
1.1st row is fine,
2. 2ND row, phn no is not filled, so it should show popup message
3. 3rd row also Name is empty, so popup needed
4.4th row, fields are missing but they are not mandatory, so we can ignore it
this excel's rows keep on increasing, Every user will be adding one new row and message has to be displayed before save.
Kindly ask if any more clarification is needed.
Thanks in advance....

 

[My Aswer Is This]

Try this:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Application.ScreenUpdating = False
Dim c As Range
    For Each c In Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
    If c.Value = "" Then MsgBox "You have empty cells": Exit Sub
    Next
    For Each c In Range("C1:C" & Cells(Rows.Count, "C").End(xlUp).Row)
    If c.Value = "" Then MsgBox "You have empty cells": Exit Sub
    Next
Application.ScreenUpdating = True
End Sub

 

[Mirzad]

Hi, Thanks for the code, I tried the same, Its working, But I have the following issues
1. Once the error message is shown, the pointer or editing mode in excel freezes,
ie after error message cursor shows symbol of loading and further editing is not possible in excel.
2.Once I close the excel and reopens the code is not activating,
ie no message is shown when saving.
Please give your valuable suggestion, Thank you

 

[Fluff]

How about

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

    With Sheets("Entry")
        If WorksheetFunction.CountA(.Columns("A")) <> .Range("A" & Rows.Count).End(xlUp).Row Then
            MsgBox " you have blanks in Column A"
            Cancel = True
            .Range("A1").End(xlDown).Offset(1).Select
            Exit Sub
        ElseIf WorksheetFunction.CountA(.Columns("C")) <> .Range("C" & Rows.Count).End(xlUp).Row Then
            MsgBox " you have blanks in Column C"
            Cancel = True
            .Range("C1").End(xlDown).Offset(1).Select
            Exit Sub
        End If
    End With

End Sub

 

[Mirzad]

Thanks a lot, Initially it showed error'9', when I removed "With sheet("Entry")", then its working.(Sorry I dont know the importance of "With" statement.)
But If the column in last row is empty it is not showing error.
ie if empty cell is in between 1st cell and last cell its showing message, but if the cell of last row is empty, its not showing message,
any suggestions??
Thanks in advance

 

[Fluff]

OK
You'll need to change the sheet name in red to the name of the your sheet.
Also with the numbers in blue, change them to match the columns you want to check, but you'll have to use column numbers rather than letters.
At the moment this will check columns A, C, D & E

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    
    Dim Col As Variant
    Dim Msg As String
    Dim Res As Long
    Dim Cl As Range
    Dim UsdRws As Long
    
    With Sheets("[COLOR=#ff0000]Entry[/COLOR]")
        UsdRws = Cells.Find("*", after:=.Range("A1"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        For Each Col In Array([COLOR=#0000ff]1, 3, 4, 5[/COLOR])
            Res = UsdRws - WorksheetFunction.CountA(.Columns(Col))
            If Res <> 0 Then
                Cancel = True
                Msg = Msg & "You have " & Res & " blank cells in Column " & Col & vbLf
                If Cl Is Nothing Then Set Cl = .Cells(1, Col).End(xlDown).Offset(1)
            End If
        Next Col
        If Cancel Then
            Cl.Select
            MsgBox Msg
        End If
    End With

End Sub

 

[Mirzad]

Wow!!!!
Thanks a lot...
Its working Perfect....
Thank you very much for your valuable time.

 

[Fluff]

Glad to help & thanks for the feedback