VBA Follow Correct Cell Even if filter on

[Cooki]

The below macro, constructs an email based off of cells.

I need to create about 96 of the same but just changing the range as they are all on the same worksheet.

This issue is when i filter and arrange the cells by A-Z the macros all start of point at the wrong range.

If the line the macro is on get filtered and is now on line 6 for the range to change with it

I thought if i did not put the absolute function $ on the cells it would work, but sadly not.



Sub Send_Email()
Dim I, J As Long
Dim xAddress As String
Dim xEmailBody As String
Dim xMailOut As Outlook.MailItem
Dim xOutApp As Outlook.Application
On Error Resume Next
xAddress = ActiveWindow.RangeSelection.Address

Application.ScreenUpdating = False
Set xOutApp = CreateObject("Outlook.Application")
Set xMailOut = xOutApp.CreateItem(olMailItem)
For I = 1 To xRg.Rows.Count
For J = 1 To xRg.Columns.Count
xEmailBody = xEmailBody & " " & xRg.Cells(I, J).Value
Next
xEmailBody = xEmailBody & vbNewLine
Next
xEmailBody = "Hi" & vbLf & vbLf & " body of message you want to add" & vbLf & vbLf & xEmailBody & vbNewLine
With xMailOut
.Subject = Sheets("Reporting Schedule").Range("I2") & " Report"
.To = Sheets("Reporting Schedule").Range("V2")
.Body = Sheets("Reporting Schedule").Range("T2")
.Display
'.Send
End With
Set xMailOut = Nothing
Set xOutApp = Nothing
Application.ScreenUpdating = True
End Sub

 

[James006]

Hello,

Could you describe the underlying logic of your 96 ranges ...

 

[Cooki]

Its a reporting scheduler, so each row in excel is a report, date its due out, report name, DL list, figures from the report.

Only a few reports are due out on the same date, so need separate macros