Try this...
Sub email()
Dim Lr As Long
Dim rngEmails As Range, rngEmail As Range, rngLine As Range
Dim OutApp As Object, strbody As String
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Application.ScreenUpdating = False
Lr = Range("H" & Rows.Count).End(xlUp).Row
Range("H1:H" & Lr).AdvancedFilter xlFilterInPlace, Unique:=True
Set rngEmails = Range("H2:H" & Lr).SpecialCells(xlCellTypeVisible)
If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
For Each rngEmail In rngEmails
Range("H1:H" & Lr).AutoFilter 1, rngEmail.Value
strbody = "Good day," & vbNewLine & "We are missing below books:" & vbNewLine
For Each rngLine In Range("A2:A" & Lr).SpecialCells(xlCellTypeVisible)
strbody = strbody & rngLine & Chr(32) & rngLine.Offset(, 1) & _
rngLine.Offset(, 2) & rngLine.Offset(, 4) & rngLine.Offset(, 5) & vbNewLine
Next rngLine
strbody = strbody & vbNewLine & "brgds," & vbNewLine & "Alex"
With OutApp.CreateItem(0)
.To = rngEmail.Value
.Subject = "Missing Books"
.Body = strbody
'.Send
.Display
End With
Next
ActiveSheet.AutoFilterMode = False
Application.ScreenUpdating = True
Set OutApp = Nothing
End Sub
Bookmarks