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

Mehow

New Member
Joined
Feb 23, 2018
Messages
11
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.
 

Some videos you may like

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
10,238
Are you saying that if any cell in C3:C16 and C19:C21 is empty, you don't want to send the email?
 

Mehow

New Member
Joined
Feb 23, 2018
Messages
11
@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'
 

Mehow

New Member
Joined
Feb 23, 2018
Messages
11
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
 

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
10,238
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
 

Dossfm0q

Banned User
Joined
Mar 9, 2009
Messages
570
Office Version
  1. 2019
Platform
  1. Windows
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
 

Watch MrExcel Video

Forum statistics

Threads
1,126,998
Messages
5,622,096
Members
415,876
Latest member
csibonga2k17

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
Top