Indirect within VBA

[stroffso]

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

 

[Rick Rothstein]

Try adding the rows I show in red below (the rest is your code reformatted to "look nicer")...

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

 

[DanteAmor]

Try:

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

 

[stroffso]

This worked perfectly, thank you

Try adding the rows I show in red below (the rest is your code reformatted to "look nicer")...

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

 

[stroffso]

This also worked perfectly I am now spoiled for choice, thanks to you both

Try:

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

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.