My macro breaks when range has only one line of text

[jmpatrick]

This is seemingly related to my last question since it also broke in a similar way with a single-line range (yet it's different): UserForm won't open because ListBox has only one line of text?

I have code that sends an email using a Range as the body of the email. After sending the email it writes an entry in a log using the Range as a comment (still with me?).

The email sends correctly, but the code stops when it tries to write the range data in a comment.

Similar to the linked issue above, when the range has two lines of data it work, when it's only a single line of data I get this error:

Run-time error '13':

Type mismatch

Here's the code:

Sub SendPlanRequestUpdateEmail()
   
    Dim Ans As VbMsgBoxResult
    Ans = MsgBox("Are you sure you want to Send a Floor Plan Request Update?", vbYesNo + vbQuestion)
    If Ans = vbNo Then Exit Sub
   
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
   
    Sheets("FloorPlanRequests").Visible = True
    Sheets("FloorPlanRequests").Select
    ActiveSheet.Unprotect

    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object

    Set rng = Nothing
    On Error Resume Next
    Set rng = Selection.SpecialCells(xlCellTypeVisible)
    Set rng = Sheets("FloorPlanRequests").Range("FloorPlanRequests").SpecialCells(xlCellTypeVisible)
    On Error GoTo 0

    If rng Is Nothing Then
        MsgBox "The selection is not a range or the sheet is protected" & _
               vbNewLine & "please correct and try again.", vbOKOnly
        Exit Sub
    End If

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

    On Error Resume Next
    With OutMail
        .To = Settings.DesignerEmailReturn.Value
        .CC = Settings.CCEmailReturn.Value
        .BCC = Settings.BCCEmailReturn.Value
        .Subject = "Floor Plan Request Update for " & Format(Now, "m/dd/yy")
        .htmlbody = "<span style=""font-size:14pt;"">In order of priority:" & RangetoHTML(rng) & "<br>" & Settings.FloorPlanRequestMessage.Value
        .Send
    End With
    On Error GoTo 0
   
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    Sheets("FloorPlanRequests").Visible = False
   
    'Insert Blank Row In MasterLog
    Sheets("MasterLog").Visible = True
    Sheets("MasterLog").Select
    ActiveSheet.Unprotect
    Rows("10:10").Select
    Selection.Insert Shift:=xlDown
    Worksheets("MasterLogTemplate").Range("1:1").Copy Worksheets("MasterLog").Range("10:10")
       
    'Log Timestamp
    Sheets("MasterLog").Range("A10") = [Text(Now(), "MM/DD/YYYY HH:MM:SS AM/PM")]
   
    'Log Update
    Dim X As Variant
    X = Sheets("FloorPlanRequests").Range("FloorPlanRequests").Value
    With Range("E10")
      .AddComment
      .Comment.Text Join(Application.Transpose(X), Chr(10))
      With .Comment.Shape.TextFrame.Characters.Font
         .Name = "Tahoma"
         .Size = 12
      End With
      .Comment.Shape.TextFrame.AutoSize = True
    End With
  
    'Log Recipient
    Sheets("MasterLog").Range("C10").Value = Settings.DesignerNames.Value
   
    'Log Action
    Sheets("MasterLog").Range("E10").Value = "Boise Plan Request Update Sent"
   
    'Log Name
    Sheets("MasterLog").Range("I10") = Application.UserName
         
    'Sort MasterLog
    Application.Goto Reference:="MasterLogTimeStampColumn"
    ActiveWorkbook.Worksheets("MasterLog").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("MasterLog").Sort.SortFields.Add2 Key:=Range( _
        "MasterLogTimeStampColumn"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("MasterLog").Sort
        .SetRange Range("MasterLogAllColumns")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
         
    With Range("MasterLogTimestampColumn")
    .Range("A" & .Rows.Count).EntireRow.Select
    End With
    ActiveWindow.SmallScroll Down:=-18
    Range("A" & (ActiveCell.Row)).Select
       
    'Goto Last Row of MasterLog
    With Range("MasterLogTimestampColumn")
    .Range("A" & .Rows.Count).EntireRow.Select
    End With
    Range("A" & (ActiveCell.Row)).Select
      
    Sheets("MasterLog").Visible = False
    Sheets("MasterLogTemplate").Visible = False
    Sheets("MasterLogGrid").Visible = False

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

    Set OutMail = Nothing
    Set OutApp = Nothing
   
    Sheets("Calendar").Select
  
End Sub

Single-line of data in Range does not work:

Two (or more) lines of data in the Range works:

 

[Fluff]

How about

    Dim X As Variant
    X = Sheets("FloorPlanRequests").Range("FloorPlanRequests").Value
    If IsArray(X) Then
      X = Join(Application.Transpose(X), Chr(10))
    End If
    With Range("E10")
      .AddComment
      .Comment.Text X

 

[jmpatrick]

How about

    Dim X As Variant
    X = Sheets("FloorPlanRequests").Range("FloorPlanRequests").Value
    If IsArray(X) Then
      X = Join(Application.Transpose(X), Chr(10))
    End If
    With Range("E10")
      .AddComment
      .Comment.Text X

Bravo! Works great. Thanks.

 

[Fluff]

You're welcome & thanks for the feedback.