RangetoHTML Works 50% of the time...

BrianExcel

Well-known Member
Joined
Apr 21, 2010
Messages
975
I am using the following RangetoHTML code in an email sub.

Code:
With OutMail
    .To = sMomEmail & "; " & sDadEmail
    .Subject = "Peanut Gallery // Injury Alert for " & sName
    .htmlbody = "<font size=""3.5"" face=""Calibri"">" & "Dear " & sParents & "," & "</font>" & "<br>" & "<br>" _
    & "<font size=""3.5"" face=""Calibri"">" & "We wanted to let you know that " & sFirstName & " had a minor injury today on " & sGender & ":" & "</font>" _
    & RangetoHTML(r) & "<br>" & "<br>" _
    & "<font size=""3.5"" face=""Calibri"">" & "<u>" & "Additional Details" & "</u>" & ": " & sDetails & "</font>" & "<br>" & "<br>" _
    & "<font size=""3.5"" face=""Calibri"">" & "If you have any questions or concerns please feel free to let us know." & "</font>" & "<br>" & "<br>" _
    & "<font size=""3.5"" face=""Calibri"">" & "Sincerely," & "</font>" & "<br>"
    .display

I have two worksheets in my workbook. Both have buttons that are coded identically to open the exact same Userform1.

The first sheet contains the source data. The second sheet, titled "Workings" contains values that are set as a range after certain checkboxes on the userform are clicked.

A button within the userform opens an email message in outlook with some text and the range from the workings page included on it.

Here is the confusing part: If I open the userform FROM the button on the "Workings" page, it works fine. BUT, if I open the userform FROM the source data page (where the user will be working from), the email message populates fine, but the range from the workings page doesn't display.

Can anyone help?

Here is the total code...


Code:
Sub InjuryEmail()
Dim OutApp As Object, OutMail As Object
Dim sName As String, sFirstName As String, sGender As String
Dim sMomName As String, sDadName As String
Dim sMomEmail As String, sDadEmail As String
Dim sDetails As String
Dim sParents As String
Dim cntl As Control, sControl As String
Dim irow As Integer, icol As Integer
Dim r As Range

irow = 1
icol = 1

Sheets("Workings").Cells.Clear

With UserForm1
    sName = .cmbStudent.Value
    sGender = .lblGender
    sMomName = .lblMomName.Caption
    sDadName = .lblDadName.Caption
    sMomEmail = .lblMomEmail
    sDadEmail = .lblDadEmail
    sDetails = UserForm1.txtInjuryDetails.Text
End With

If InStr(sName, " ") Then
    sFirstName = Split(sName, " ")(0)
End If

If sGender = "Male" Then
    sGender = "his"
Else
    sGender = "her"
End If

If InStr(sMomName, " ") Then
    sMomName = Split(sMomName, " ")(0)
End If

If InStr(sDadName, " ") Then
    sDadName = Split(sDadName, " ")(0)
End If

sParents = sMomName & " and " & sDadName

If sMomName = "" Then
    sParents = sDadName
End If

If sDadName = "" Then
    sParents = sMomName
End If

For Each cntl In UserForm1.frmInjury.Controls
    If Left(cntl.Name, 3) = "cbx" Then
        If cntl.Value = True Then
            With Sheets("Workings")
                .Cells(irow, icol) = cntl.Caption
                irow = irow + 1
            End With
        End If
    End If
Next cntl

irow = 1
icol = 1

With Sheets("Workings")
    Set r = Range(Cells(irow, icol), Cells(irow, icol).End(xlDown))[COLOR="Red"]<--Here is where the range is set[/COLOR]
    r.Font.Size = "12"
End With

On Error GoTo Email_Error

On Error Resume Next

On Error GoTo 0

With Application
    .EnableEvents = False
    .ScreenUpdating = False
End With

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
    .To = sMomEmail & "; " & sDadEmail
    .Subject = "Peanut Gallery // Injury Alert for " & sName
    .htmlbody = "<font size=""3.5"" face=""Calibri"">" & "Dear " & sParents & "," & "</font>" & "<br>" & "<br>" _
    & "<font size=""3.5"" face=""Calibri"">" & "We wanted to let you know that " & sFirstName & " had a minor injury today on " & sGender & ":" & "</font>" _
    & RangetoHTML(r) & "<br>" & "<br>" _[COLOR="red"]Here is the range in the email.[/COLOR]
    & "<font size=""3.5"" face=""Calibri"">" & "<u>" & "Additional Details" & "</u>" & ": " & sDetails & "</font>" & "<br>" & "<br>" _
    & "<font size=""3.5"" face=""Calibri"">" & "If you have any questions or concerns please feel free to let us know." & "</font>" & "<br>" & "<br>" _
    & "<font size=""3.5"" face=""Calibri"">" & "Sincerely," & "</font>" & "<br>"
    .display

End With
On Error GoTo 0

With Application
    .EnableEvents = True
    .ScreenUpdating = True
End With

Email_Exit:
Set OutMail = Nothing
Set OutApp = Nothing

On Error GoTo 0
Exit Sub

Email_Error:

MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Email of Module EmailCode"
Err.Clear
GoTo Email_Exit

End Sub

I don't understand why it would work on the same userform from one button, but not from another. Thoughts?
 

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.

Forum statistics

Threads
1,215,425
Messages
6,124,824
Members
449,190
Latest member
rscraig11

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