Email 2 Non Consecutive Columns

[Wheelie686]

I need to send Column 1 (A2:A8) along with 1 of 9 columns, depending on the date in Row 2 - which I need to be yesterday (so Date-1).

I have the following that will the email entire range A1:J8, which of course includes columns I don't need.

<code style="margin: 0px; padding: 0px; font-style: inherit; font-weight: inherit; line-height: 12px;">Sub Send()
    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object
                
    Dim sh As Worksheet
    Set sh = Sheets("Chat Summary")
    
    On Error Resume Next
    Set rng = Sheets("Chat Summary").Range("A1:J8")
    
    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

    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 = sh.Range("B10")
        .CC = sh.Range("B11")
        .BCC = ""
        .Subject = "Reactive Chat Info " & Date - 1
        .HTMLBody = RangetoHTML(rng)
        '.Attachments.Add ActiveWorkbook.FullName
        .SentOnBehalfOfName = Sheets("Reference").Range("S1")
        .Display
    End With
    On Error GoTo 0

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

    Set OutMail = Nothing
    Set OutApp = Nothing
    
    'ActiveWorkbook.Save
End Sub</code>

I then have the following code which selects the column I need based on the date. However this leaves out Column A.
Does anyone have a suggestion as how to combine these 2?

<code style="margin: 0px; padding: 0px; font-style: inherit; font-weight: inherit; line-height: 12px;">Sub SendV2()
    Dim aCell As Range
    With ThisWorkbook.Sheets("Chat Summary")
        Set aCell = .Rows(2).Find(What:=Date - 1, LookIn:=xlValues, LookAt:=xlWhole, _
                                          MatchCase:=False, SearchFormat:=False)
        If Not aCell Is Nothing Then
            Range(aCell, aCell.End(xlDown)).Select
        Else
            MsgBox "Date Not Found"
        End If
    End With
    
    Dim rng2 As Range
    Set rng2 = Range(aCell, aCell.End(xlDown))
    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object
    Dim sh As Worksheet
    Set sh = Sheets("Chat Summary")
    
    On Error Resume Next
    Set rng = Sheets("Chat Summary").Range("A2:A8")
    
    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

    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 = sh.Range("B10")
        .CC = sh.Range("B11")
        .BCC = ""
        .Subject = "Reactive Chat Info " & Date - 1
        .HTMLBody = RangetoHTML(rng2)
        '.Attachments.Add ActiveWorkbook.FullName
        .SentOnBehalfOfName = Sheets("Reference").Range("S1")
        .Display
    End With
    On Error GoTo 0

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

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub</code>