Email Row in cell in column is filled out.

[k03074]

Hello,

It's been brought to me to see if this can be done. We have a spreadsheet contain information for our quality department. After someone enters information in Column H they would like that row A thru I to be emailed to bunch of people. If someone leaves column H blank we don't want it to be emailed, only if it's not blanked. Does anyone have suggestions in how I can start this?

Thank you,
Gerald

 

[daverunt]

Hi,

Here's the code to detect a change in the column rows.
It should pop up a msgbox if the cell has content changed/added. If deleted no message.
I don't have time to do the email part right now.

The code is pasted in the relevant worksheet of the VBA project - not a module

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range
    
    LastRow = Range("H:H").Rows.Count
    
    ' The variable KeyCells contains the cells that will
    ' cause an alert when they are changed.
    
    Set KeyCells = Range("H1:H" & LastRow)
    
    If Not Application.Intersect(KeyCells, Range(Target.Address)) _
           Is Nothing Then
        
        If Target = "" Then
        Else
        MsgBox "Cell " & Target.Address & " has changed."
        MsgBox (Target.row)
       
       
        End If
        
    End If
End Sub

 

[k03074]

Great!

Thank you

 

[daverunt]

Here's one with the basic mail. It should give you a good start.
I added a link for the source of the code.
The column offset reference is plus or minus from H. minus being left so -7 = Column A. zero means it's the same row

Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Dim objMail As Object
Dim OutMail As Object

'https://support.microsoft.com/en-gb/help/213612/how-to-run-a-macro-when-certain-cells-change-in-excel
    
    LastRow = Range("H:H").Rows.Count
    
    ' The variable KeyCells contains the cells that will
    ' cause an alert when they are changed.
    
    Set KeyCells = Range("H1:H" & LastRow)
    
    If Not Application.Intersect(KeyCells, Range(Target.Address)) _
           Is Nothing Then

      
        
        If Target = "" Then
        Else
        'MsgBox "Cell " & Target.Address & " has changed."
        'MsgBox (Target.row)
        Rw = Target.row

' create email
        Set objOutlook = CreateObject("Outlook.Application")
        Set objMail = objOutlook.CreateItem(0)
           
        strEmail = "test@yahoo.com"
        strSubject = "Enter subject or use a cell range reference"
        
        strbody = Cells(Rw, 8).Offset(0, -7).Value & vbNewLine _
                & Cells(Rw, 8).Offset(0, -6).Value & vbNewLine _
                & Cells(Rw, 8).Offset(0, -5).Value & vbNewLine _
                & Cells(Rw, 8).Offset(0, -4).Value & vbNewLine _
                & Cells(Rw, 8).Offset(0, -3).Value & vbNewLine _
                & Cells(Rw, 8).Offset(0, -2).Value & vbNewLine _
                & Cells(Rw, 8).Offset(0, -1).Value & vbNewLine _
                & Cells(Rw, 8).Offset(0, 1).Value & vbNewLine _
      
      
With objMail
   .To = strEmail
   .Subject = strSubject
   .Body = strbody
   .Display
   '.Send
   
End With
       
        End If
        
    End If
End Sub

 

[k03074]

That works great. I always forget about the offset.

I been looking at using Google Gmail STMP settings. I can seem to get it working.

Here is my code:

---

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range
    ' The variable KeyCells contains the cells that will
    ' cause an alert when they are changed.
    Set KeyCells = Range("H1:H1048576")
    
    If Not Application.Intersect(KeyCells, Range(Target.Address)) _
           Is Nothing Then
           
           Answer = MsgBox("Do you want to email this to the update for NTR #: " & Range("B" & (Target.Row)).Value & _
           vbNewLine & "With the following disposition information: " & Range("H" & (Target.Row)).Value & "?", vbYesNoCancel, "")
        
            If Answer = vbYes Then
                
              Dim iMsg As Object
    Dim iConf As Object
    Dim strbody As String
    Dim Flds As Variant
    
    Set iMsg = CreateObject("CDO.Message")
    Set iConf = CreateObject("CDO.Configuration")
        iConf.Load -1    ' CDO Source Defaults
        Set Flds = iConf.Fields
        With Flds
            .Item("[URL]http://schemas.microsoft.com/cdo/configuration/sendusing[/URL]") = 2
  .Item("[URL]http://schemas.microsoft.com/cdo/configuration/smtpserver[/URL]") = "smtp.gmail.com"
  .Item("[URL]http://schemas.microsoft.com/cdo/configuration/smtpserverport[/URL]") = 587
  .Item("[URL]http://schemas.microsoft.com/cdo/configuration/smtpauthenticate[/URL]") = 1
  .Item("[URL]http://schemas.microsoft.com/cdo/configuration/smtpusessl[/URL]") = True
  .Item("[URL]http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout[/URL]") = 60
  .Item("[URL]http://schemas.microsoft.com/cdo/configuration/sendusername[/URL]") = "[EMAIL="uername@gmail.com"]uername@gmail.com[/EMAIL]"
  .Item("[URL]http://schemas.microsoft.com/cdo/configuration/sendpassword[/URL]") = "password"
  .Update 'Let CDO know we have changed the default configuration for this message
        End With
    strbody = "This line has been updated with a dispoistion:" & vbNewLine & vbNewLine & _
         "Job Number: " & Range("A" & Target.Row) & vbNewLine & _
         "NTR #: " & Range("B" & Target.Row) & vbNewLine & _
         "Non-Conformance:  " & Range("F" & Target.Row) & vbNewLine & _
         "Disposition: " & Range("H" & Target.Row) & vbNewLine & vbNewLine & _
         "Click Below to open Database up" & vbNewLine & _
        "<[URL="file://\\Quality\NTR"]\\Quality\NTR[/URL] Database\NTR Log Book.xlsm>" & vbNewLine & vbNewLine & _
        "Please do not reply to this email.  If you have any question please address them to the Quality Team ." & vbNewLine & vbNewLine & _
        "Thank you,"

    With iMsg
        Set .Configuration = iConf
        .To = "[EMAIL="test@gmail.com"]test@gmail.com[/EMAIL]"
        .CC = ""
        .BCC = ""
        .From = """NTR Database"" <[EMAIL="test@test.ca"]test@test.ca[/EMAIL]>"
        .Subject = "NTR Database update for Disposition for job number: " & Range("A" & Target.Row)
        .TextBody = strbody
        .Send
    End With
    Set iMsg = Nothing
    Set iConf = Nothing
    Set Flds = Nothing
            
    
    End If
       
    End If
End Sub

 

[daverunt]

I haven't used cdo since WinXP so I would suspect it's more than a script problem if all of the settings are right.
I'll have a go with it if I get time.