Excel VBA Course
Excel VBA Course - From Beginner to Expert

200+ Video Lessons
50+ Hours of Video
200+ Excel Guides

Become a master of VBA and Macros in Excel and learn how to automate all of your tasks in Excel with this online course. (No VBA experience required.)

View Course

Send excel cell data to email using Visual Basic code

0

Help!!  I have been tasked with sending excel comment data to an email when there are issues with generators or fuel tanks.  Never have used Visual basic before!  Found ideas and it works but there has to be an easier way?This is from the fuel log and had to move excel columns to kind of make work because i couldnt figure out how to get data after the comment cell.  I tried looping, but could not figure out. Data range is (J7:M13) and (A58:M63).  Thanks!!

Dim xRg As Range

'Updated by Extendoffice 2017/9/12
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    Set xRg = Range("L7")
    Set xRg = Range("M7")
    Set xRg = Range("J7")
    If xRg = Target And Target.Value > 50 Then
        Call Send_Range
    End If
    If Target.Cells.Count > 1 Then Exit Sub
    Set xRg = Range("J8")
    If xRg = Target And Target.Value > 50 Then
    Set xRg = Range("L8")
    Set xRg = Range("M8")
        Call Send_Range
    End If
    If Target.Cells.Count > 1 Then Exit Sub
    Set xRg = Range("J9")
    If xRg = Target And Target.Value > 50 Then
    Set xRg = Range("L9")
    Set xRg = Range("M9")
        Call Send_Range
    End If
    If Target.Cells.Count > 1 Then Exit Sub
    Set xRg = Range("J10")
    If xRg = Target And Target.Value > 50 Then
    Set xRg = Range("L10")
    Set xRg = Range("M10")
        Call Send_Range
    End If
    If Target.Cells.Count > 1 Then Exit Sub
    Set xRg = Range("J11")
    If xRg = Target And Target.Value > 50 Then
    Set xRg = Range("L11")
    Set xRg = Range("M11")
        Call Send_Range
    End If
    If Target.Cells.Count > 1 Then Exit Sub
    Set xRg = Range("J12")
    If xRg = Target And Target.Value > 50 Then
    Set xRg = Range("L12")
    Set xRg = Range("M12")
        Call Send_Range
    End If
    If Target.Cells.Count > 1 Then Exit Sub
    Set xRg = Range("J13")
    If xRg = Target And Target.Value > 50 Then
    Set xRg = Range("L13")
    Set xRg = Range("M13")
        Call Send_Range
    End If
    If Target.Cells.Count > 1 Then Exit Sub
    Set xRg = Range("A59")
    Set xRg = Range("H59")
    Set xRg = Range("L59")
    Set xRg = Range("M59")
    If xRg = Target And Target.Value > 50 Then
        Call Send_Range_1
    End If
    If Target.Cells.Count > 1 Then Exit Sub
    Set xRg = Range("A60")
    Set xRg = Range("H60")
    Set xRg = Range("L60")
    Set xRg = Range("M60")
    If xRg = Target And Target.Value > 50 Then
        Call Send_Range_1
    End If
    If Target.Cells.Count > 1 Then Exit Sub
    Set xRg = Range("A61")
    Set xRg = Range("H61")
    Set xRg = Range("L61")
    Set xRg = Range("M61")
    If xRg = Target And Target.Value > 50 Then
        Call Send_Range_1
    End If
    If Target.Cells.Count > 1 Then Exit Sub
    Set xRg = Range("A62")
    Set xRg = Range("H62")
    Set xRg = Range("L62")
    Set xRg = Range("M62")
    If xRg = Target And Target.Value > 50 Then
        Call Send_Range_1
    End If
    If Target.Cells.Count > 1 Then Exit Sub
    Set xRg = Range("A63")
    Set xRg = Range("H63")
    Set xRg = Range("L63")
    Set xRg = Range("M63")
    If xRg = Target And Target.Value > 50 Then
        Call Send_Range_1
    End If
End Sub
Sub Send_Range()
  
   ' Select the range of cells on the active worksheet.
   ActiveSheet.Range("J6:M13").Select
  
   ' Show the envelope on the ActiveWorkbook.
   ActiveWorkbook.EnvelopeVisible = True
  
   ' Set the optional introduction field thats adds
   ' some header text to the email body. It also sets
   ' the To and Subject lines. Finally the message
   ' is sent.
   With ActiveSheet.MailEnvelope
      .Introduction = "Bradley Booster Fuel Weekly Remarks."
      .Item.To = "whartsnet.net.com"
      .Item.Subject = "Bradley Booster Fuel Weekly Remarks"
      .Item.Send
   End With
End Sub
Sub Send_Range_1()
  
   ' Select the range of cells on the active worksheet.
   ActiveSheet.Range("A58:M63").Select
  
   ' Show the envelope on the ActiveWorkbook.
   ActiveWorkbook.EnvelopeVisible = True
  
   ' Set the optional introduction field thats adds
   ' some header text to the email body. It also sets
   ' the To and Subject lines. Finally the message
   ' is sent.
   With ActiveSheet.MailEnvelope
      .Introduction = "Bradley Booster Fuel Condition and Action Taken."
      .Item.To = "whart@ctwater.com"
      .Item.Subject = "Bradley Booster Fuel Condition and Action Taken"
      .Item.Send
   End With
End Sub

excelmacros-vba
posted by: whart on Thu Jan 25, 2018 at 9:09 pm
Answer
Discuss

Answers

0

You said that your code works. The code below will work if yours did. I had no way of testing all of it. However, I did sort the various tests. One of them is when the procedure should fire. I limited that to the cells I know about. Please take a look how it was limited and tweak as required.

All results are tested against a value of 50 which makes your job look very easy - but that what your code had too, lol: I suggest you try, and then we see.

' modified from Extendoffice 2017/9/12
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    ' 25 Jan 2018
    
    Dim Advise As Integer                   ' 0 = all OK, 1 = Test 1, 2 = Test 2
    Dim Rng As Range
    Dim R As Long                           ' row counter
    Dim SendRng As Range
    Dim Intro As String
    If Target.Cells.Count > 1 Then Exit Sub
    
    ' event fires only if one of following cells was changed
    Set Rng = Application.Union(Range("J7:J13"), _
                                Range("L7:M13"), _
                                Range("A59:A63"), _
                                Range("H59:H63"), _
                                Range("L59:M63"))
    If Not Application.Intersect(Target, Rng) Is Nothing Then
        For R = 7 To 13
            If SumUp("JLM", R) > 50 Then
                Advise = 1                  ' Test 1
                Exit For
            End If
        Next R
        
        If Not Advise Then
            For R = 59 To 63
                If SumUp("AHLM", R) > 50 Then
                    Advise = 2              ' Test 2
                    Exit For
                End If
            Next R
        End If
        
        If Advise Then                      ' if Advice is triggered
            Intro = Split(",Weekly Remarks,Condition and Action Taken", ",")(Advise)
            Set SendRng = Range(Split(",J6:M13,A58:M63", ",")(Advise))
            SendMail Intro, SendRng
        End If
    End If
End Sub
Private Function SumUp(Clms As String, _
                       R As Long) As Single
    ' 25 Jan 2018
    
    Dim Fun As Single
    Dim n As Long
    
    For n = 1 To Len(Clms)
        Fun = Fun + Val(Cells(R, Columns(Mid(Clms, n, 1)).Column).Value)
    Next n
    SumUp = Fun
End Function
Private Sub SendMail(ByVal Intro As String, _
                     SendRng As Range)
   
   ' Select the range of cells on the active worksheet.
    SendRng.Select
   
   ' Show the envelope on the ActiveWorkbook.
   ActiveWorkbook.EnvelopeVisible = True
   
   ' Set the optional introduction field thats adds
   ' some header text to the email body.
   ' It also sets the To and Subject lines.
   ' Finally the message is sent.
   With ActiveSheet.MailEnvelope
      .Introduction = "Bradley Booster Fuel " & Intro
      .Item.To = "whartsnet.net.com"
      .Item.Subject = .Introduction
      .Item.Send
   End With
End Sub
posted by: Variatus (rep: 4889) on Thu Jan 25, 2018 at 11:09 pm
Discuss

Discussion

HELP again!!!  This looks really cool, but when i put the code into VBA for the excel sheet, Sheet1, and try to run a macro screen comes up and i cant figure out how to name it.  This is so new to me and confusing at times.  Thanks for the help so far!! 
whart Jan 26, '18 at 9:56 am
The "macro screen" that comes up is likely to have a message for you. If you need help with that message, share its text.
Most likely, you have an error message. Such a message displays an error number and the corresponding description. That is vital information without which no further progress is possible.
The message would also have a Debug button. Press it. The screen will change to the VB Editor and the line of code that caused the error will be highlighted. Let me know which line it is.
Variatus (rep: 4889) Jan 26, '18 at 9:07 pm
Add to Discussion


Answer the Question

You must create an account to use the forum. Create an Account or Login