Indirect within VBA

stroffso

Board Regular
Joined
Jul 12, 2016
Messages
160
Office Version
  1. 365
Platform
  1. Windows
Hi,
I have some code that sends emails based on a range of cells however I want to make the reference indirect as sometimes there will be 5 rows to send and others there will be 25 rows. The below code works fine I just need help on the row that says " For Each cell In ws.Range("A2:A2")", how do I make this dynamic to only pick up rows with data in them from row 2 down? So if Column A is populated then it gets picked up?

Sub SendMail()


Dim objOutlook As Object
Dim objMail As Object
Dim ws As Worksheet

Set objOutlook = CreateObject("Outlook.Application")
Set ws = ActiveSheet

For Each cell In ws.Range("A2:A2")

Set objMail = objOutlook.CreateItem(0)

With objMail
.To = cell.Value
.Subject = cell.Offset(0, 2).Value
.Body = cell.Offset(0, 3).Value
.Attachments.Add cell.Offset(0, 4).Value
.CC = cell.Offset(0, 1).Value
.Send
End With

Set objMail = Nothing
Next cell

Set ws = Nothing
Set objOutlook = Nothing


End Sub

thanks
 

Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.
Try adding the rows I show in red below (the rest is your code reformatted to "look nicer")...
Code:
Sub SendMail()
  Dim objOutlook As Object
  Dim objMail As Object
  Dim ws As Worksheet
  
  Set objOutlook = CreateObject("Outlook.Application")
  Set ws = ActiveSheet
  
  For Each Cell In ws.Range("A2:A2")
  
    [B][COLOR="#FF0000"]If Len(Cell) Then[/COLOR][/B]
    
      Set objMail = objOutlook.CreateItem(0)
      
      With objMail
        .To = Cell.Value
        .Subject = Cell.Offset(0, 2).Value
        .Body = Cell.Offset(0, 3).Value
        .Attachments.Add Cell.Offset(0, 4).Value
        .CC = Cell.Offset(0, 1).Value
        .Send
      End With
      
      Set objMail = Nothing
    
    [B][COLOR="#FF0000"]End If[/COLOR][/B]
    
  Next Cell
  
  Set ws = Nothing
  Set objOutlook = Nothing
End Sub
 
Upvote 0
Try:

Code:
Sub SendMail()
  Dim objOutlook As Object, objMail As Object
  Dim ws As Worksheet, cell As Range
  
  Set objOutlook = CreateObject("Outlook.Application")
  Set ws = ActiveSheet
  For Each cell In [COLOR=#0000ff]ws.Range("A2", ws.Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeConstants)[/COLOR]
    Set objMail = objOutlook.CreateItem(0)
    With objMail
      .To = cell.Value
      .Subject = cell.Offset(0, 2).Value
      .Body = cell.Offset(0, 3).Value
      .Attachments.Add cell.Offset(0, 4).Value
      .CC = cell.Offset(0, 1).Value
      .Send
    End With
    Set objMail = Nothing
  Next cell
  Set ws = Nothing
  Set objOutlook = Nothing
End Sub
 
Upvote 0
This worked perfectly, thank you

Try adding the rows I show in red below (the rest is your code reformatted to "look nicer")...
Code:
Sub SendMail()
  Dim objOutlook As Object
  Dim objMail As Object
  Dim ws As Worksheet
  
  Set objOutlook = CreateObject("Outlook.Application")
  Set ws = ActiveSheet
  
  For Each Cell In ws.Range("A2:A2")
  
    [B][COLOR=#FF0000]If Len(Cell) Then[/COLOR][/B]
    
      Set objMail = objOutlook.CreateItem(0)
      
      With objMail
        .To = Cell.Value
        .Subject = Cell.Offset(0, 2).Value
        .Body = Cell.Offset(0, 3).Value
        .Attachments.Add Cell.Offset(0, 4).Value
        .CC = Cell.Offset(0, 1).Value
        .Send
      End With
      
      Set objMail = Nothing
    
    [B][COLOR=#FF0000]End If[/COLOR][/B]
    
  Next Cell
  
  Set ws = Nothing
  Set objOutlook = Nothing
End Sub
 
Upvote 0
This also worked perfectly I am now spoiled for choice, thanks to you both

Try:

Code:
Sub SendMail()
  Dim objOutlook As Object, objMail As Object
  Dim ws As Worksheet, cell As Range
  
  Set objOutlook = CreateObject("Outlook.Application")
  Set ws = ActiveSheet
  For Each cell In [COLOR=#0000ff]ws.Range("A2", ws.Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeConstants)[/COLOR]
    Set objMail = objOutlook.CreateItem(0)
    With objMail
      .To = cell.Value
      .Subject = cell.Offset(0, 2).Value
      .Body = cell.Offset(0, 3).Value
      .Attachments.Add cell.Offset(0, 4).Value
      .CC = cell.Offset(0, 1).Value
      .Send
    End With
    Set objMail = Nothing
  Next cell
  Set ws = Nothing
  Set objOutlook = Nothing
End Sub
 
Upvote 0

Forum statistics

Threads
1,223,958
Messages
6,175,642
Members
452,663
Latest member
MEMEH

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top