send automated email with comment based on checked box

Hello cmccabe,

It would be easier to spot the problem with a copy of the workbook. Can you post a copy?

Hello Christopher,

I have been busy but have a solution to your problem. I created two macros for the ActiveX combo boxes.

Since you are locating these by cell address, it is very important the check box fits inside the cell. The macro AddCheckBoxes will add an ActiveX check box and center it in each cell you have selected. This prevents errors in locating the check box by cell address.

The second macro MapCheckBoxes creates a dictionary object to store the check boxes in. The check boxes are returned from the dictionary by the cell address. The cell address is in absolute A1 style, i.e. $A$1. If you enter a cell address that does not have a check box, an error will occur.

I am not sure why you are using Chr(14) in your code, but I left it intact. I was going to change to Chr(13), carriage return, but decided perhaps the recipient's email client may require it.

Here is the code that has been added...

Module - Checkbox_Macros

Global ChkBoxes As Object

Sub MapCheckBoxes(ByRef Wks As Worksheet)

    Dim obj As Object
    Dim Wks As Worksheet
    
        If ChkBoxes Is Nothing Then
            Set ChkBoxes = CreateObject("Scripting.Dictionary")
            ChkBoxes.CompareMode = vbTextCompare
        End If
        
        For Each obj In Wks.OLEObjects
            If TypeName(obj.Object) = "CheckBox" Then
                If Not ChkBoxes.Exists(obj.TopLeftCell.Address) Then
                    ChkBoxes.Add obj.TopLeftCell.Address, obj
                End If
            End If
        Next obj
        
End Sub

Sub AddCheckBoxes()

    ' Add an ActiveX CheckBox to the center of each selected cell.
    
    Dim Cell    As Range
    Dim ChkBox  As Object
    Dim Rng     As Range
    Dim Wks     As Worksheet
    
        Set Wks = ActiveSheet
        
        Set Rng = Application.Selection
        If TypeName(Rng) <> "Range" Then Exit Sub
        
            For Each Cell In Rng
                Set ChkBox = Wks.OLEObjects.Add("Forms.CheckBox.1")
                ChkBox.Height = 13.5
                ChkBox.Width = 16.5
                ChkBox.Left = Cell.Left + ((Cell.Width - ChkBox.Width) / 2)
                ChkBox.Top = Cell.Top + ((Cell.Height - ChkBox.Height) / 2)
            Next Cell
            
End Sub

CommandButton1_Click()

Private Sub CommandButton1_Click()

    Dim WS As Worksheet, Rng As Range, c As Range
    Dim OutApp As Object, OutMail As Object
    Dim Msg As String, Addr As String, FName As String, i As Long
    Dim MyFile As String
    Dim obj As Object, InBox As Object
    
        MyFile = "C:\Users\cmccabe\Desktop\DOSE reporting form 10-14-15.xlsx"
        
        If Dir(MyFile) = "" Then
            MsgBox "The file to attach was not found." & vbLf & vbLf & MyFile, vbExclamation, "Aborting Email"
            GoTo Cleanup
        End If
        
        On Error Resume Next
            Set OutApp = GetObject(, "Outlook.Application")
            If OutApp Is Nothing Then
                Set OutApp = CreateObject("Outlook.Application")
            End If
            Set InBox = OutApp.Session.GetDefaultFolder(4)
        On Error GoTo 0
        
        Set WS = ThisWorkbook.Sheets("Sheet1")
        Set Rng = WS.Range("A2", WS.Range("A" & Rows.Count).End(xlUp))
        
        Call MapCheckBoxes(WS)
    
        For Each c In Rng
            Msg = Msg & "For " & c.Offset(, 1) & Chr(14) & Chr(14)
                For i = 3 To 14
                    If CheckBoxes(WS.Cells(c.Row, "Checkbox" & i - 1).Object).Value = True Then
                        Msg = Msg & "   -" & WS.Cells(1, i) & Chr(14)
                    End If
                Next i
            Msg = Msg & Chr(14) & "Thank you,"
            Msg = Msg & Chr(14) & "Christopher McCabe"
            
                With OutApp.CreateItem(0)
                    .To = c.Offset(, 0)
                    .CC = ""
                    .BCC = ""
                    .Subject = "Daily Operational Safety Briefing"
                    .Body = Msg
                    .Attachments.Add MyFile, 1
                    .Send
                End With
        
            MsgBox "The data has been emailed sucessfully.", vbInformation
        Next c
    
Cleanup:
        Set OutApp = Nothing

End Sub

Hello Christopher,

You're welcome. If you have any questions about what the code does, please ask. I will be glad to explain it.