VBA to give an error message when button is clicked and some cells are empty

Mehow

New Member
Joined
Feb 23, 2018
Messages
15
Hi Folks,

I'm trying to insert a code into my file that performs a check for empty cells.
The idea is that this macro should check Cells C3:C16 C19:C21 if any of them is empty and return an error if that's the case.

This macro is assigned to a Button1 that displays text 'send request'
I tried a macro that simply hid the button until all cells are filled but it was too confusing for the users.

VBA Code:
Sub Email_CurrentWorkBook()

    
    Dim OlApp As Object
    Dim NewMail As Object

    Set OlApp = CreateObject("Outlook.Application")
    Set NewMail = OlApp.CreateItem(0)

    On Error Resume Next
    With NewMail
        .to = "xx"
        .CC = ""
        .BCC = ""
        .Subject = "xx"
        .HTMLBody = "<HTML><BODY>xx</BODY></HTML>"
        .Attachments.Add ActiveWorkbook.FullName
        .display   ' .display only - this must be manually checked before sending 
    End With
    On Error GoTo 0

    Set NewMail = Nothing
    Set OlApp = Nothing
End Sub

I'm struggling on how to add the Call MsgBox if range is blank/empty

Hope this makes sense :v

Thank you all in advance,
Mehow.
 

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.
Are you saying that if any cell in C3:C16 and C19:C21 is empty, you don't want to send the email?
 
Upvote 0
@mumps
That's correct, if any of these cells are blank/empty I want an erorr message to display something like 'please fill all the fields before sending'
 
Upvote 0
I managed to get this going
VBA Code:
Sub email_current_workbook_errorMSG()
Dim rng As Range
Dim cel As Range
Dim iBlank As Integer
Dim OutApp As Object
Dim OutMail As Object

Set rng = Sheet1.Range("C3,C4,C5,C6,C7,C8,C9,C10,C11,C12,C13,C14,C15,C16,C19,C20") 

For Each cel In rng
    If cel.Value = "" Then iBlank = iBlank + 1
Next cel

If iBlank > 0 Then  
    Call MsgBox("some complete all fields text here", vbOKOnly + vbCritical, "Missing Info")
Else
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    On Error Resume Next
    With OutMail
        .To = "xx"
        .CC = ""
        .BCC = ""
        .Subject = "xx"
        .HTMLBody = "<HTML><BODY>xx</BODY></HTML>"
        .display    ' .display only - this must be manually checked before sending 
    End With
    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
End If

End Sub
 
Upvote 0
Try:
VBA Code:
Sub Email_CurrentWorkBook()
    If WorksheetFunction.CountA(Range("C3:C16,C19:C21")) = 0 Then
        MsgBox ("Please fill all the fields before sending.")
        Exit Sub
    End If
    Dim OlApp As Object
    Dim NewMail As Object
    Set OlApp = CreateObject("Outlook.Application")
    Set NewMail = OlApp.CreateItem(0)
    On Error Resume Next
    With NewMail
        .to = "xx"
        .CC = ""
        .BCC = ""
        .Subject = "xx"
        .HTMLBody = "<HTML><BODY>xx</BODY></HTML>"
        .Attachments.Add ActiveWorkbook.FullName
        .display   ' .display only - this must be manually checked before sending
    End With
    On Error GoTo 0
    Set NewMail = Nothing
    Set OlApp = Nothing
End Sub
 
Upvote 0
another option
Hi Like this
Your Feedback is highly appreciated
VBA Code:
Sub Email_CurrentWorkBook()

If WorksheetFunction.CountIf(Range("C3:C16"), "=?*") _
+ WorksheetFunction.CountIf(Range("C19:C21"), "=?*") = 0 Then
    Set WB = ThisWorkbook: Set WS = WB.Worksheets(1)
    Dim OutApp As Object
    Dim OutMail As Object
  
        
            On Error Resume Next
            Set OutApp = GetObject(, "Outlook.Application")
            On Error GoTo 0
            
            If OutApp Is Nothing Then
               Shell ("OUTLOOK")
            Else
              
            End If
        
            Set OutApp = CreateObject("Outlook.Application")
            Set OutMail = OutApp.CreateItem(0)
            
            
            
            With OutMail
                    .To = "xx"
                    .CC = ""
                    .BCC = ""
                    .Subject = "xx"
                    .HTMLBody = "<HTML><BODY>xx</BODY></HTML>"
                    .Attachments.Add WB.FullName
                    .Display ' .display only - this must be manually checked before sending
            End With
            
            Set OutMail = Nothing
            Set OutApp = Nothing
Else

MsgBox "Empty"
            
End If
End Sub
 
Upvote 0

Forum statistics

Threads
1,214,954
Messages
6,122,461
Members
449,085
Latest member
ExcelError

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top