Reports

you can use this i think :

Sub email_range()

    Dim OutApp As Object
    Dim OutMail As Object
    Dim Count_row As Long, count_col As Long
    Dim pop As Range
    Dim strl As String
    Dim Signature As Variant
    Dim ResultsSheet As Worksheet
    Dim NewSheet As Worksheet
    Dim LastRow As Long
    Dim i As Long
    Dim OutputRow As Long

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

    ' Determine the last row and column
    Count_row = WorksheetFunction.CountA(ResultsSheet.Range("A1", ResultsSheet.Range("A1").End(xlDown)))
    count_col = WorksheetFunction.CountA(ResultsSheet.Range("A1", ResultsSheet.Range("A1").End(xlToRight)))

    ' Create a new worksheet for filtered results
    Set NewSheet = ThisWorkbook.Worksheets.Add
    OutputRow = 1

    ' Loop through the rows of the Results sheet
    For i = 1 To Count_row
        If ResultsSheet.Cells(i, "C").Value = 0 Or ResultsSheet.Cells(i, "C").Value = 1 Then ' Assuming "on buy" is in column C
            NewSheet.Cells(OutputRow, 1).Value = ResultsSheet.Cells(i, 1).Value ' Item
            NewSheet.Cells(OutputRow, 2).Value = ResultsSheet.Cells(i, 2).Value ' Description
            NewSheet.Cells(OutputRow, 3).Value = ResultsSheet.Cells(i, 3).Value ' On Buy
            OutputRow = OutputRow + 1
        End If
    Next i

    ' Set the range for the email body
    Set pop = NewSheet.Range(NewSheet.Cells(1, 1), NewSheet.Cells(OutputRow - 1, 3))

    strl = "<BODY style = font-size:12pt;font-family:Calibri>" & _
           "Hello all, <br><br> Can you advise<br>"

    On Error Resume Next

    With OutMail
        .To = "[email protected]"
        .CC = ""
        .BCC = ""
        .Subject = "Remove"
        .Display
        .HTMLBody = strl & RangetoHTML(pop) & .HTMLBody
    End With

    On Error GoTo 0

    ' Clean up
    Application.DisplayAlerts = False
    NewSheet.Delete
    Application.DisplayAlerts = True

    Set OutMail = Nothing
    Set OutApp = Nothing

End Sub

Function RangetoHTML(rng As Range) As String
    ' (The existing RangetoHTML function code remains unchanged)
End Function

To go further:

Loop through the Results Sheet: The loop checks each row in the Results sheet. It assumes that the "on buy" data is in column C. You may need to adjust the column index based on your actual layout.
New Worksheet Creation: A new worksheet is created to store the filtered results. This is done to avoid modifying the original data directly.
Conditional Copying: If the "on buy" value is 0 or 1, the "item" and "description" are copied to the new sheet.
Set Range for Email: After the loop, the new sheet's range is set for the email body.
Clean Up: The temporary worksheet is deleted after sending the email to keep the workbook tidy.

79492049

To go further: