VBA - Run code then move to next row and update cell reference to next row

[Jacki]

Hello folks,

I am hoping someone might be able to help out with some VBA code.

I have the following code, which works fine for the first row. After it has completed that row I want it to move to next row until the cells are blank.

I think I need to set the range as an integer, but I am not sure if that is right or how to do that. Appreciate any help! TIA

Jacki

Sub Mail_send_Mail_Outlook()
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.To = "email@address"
.Subject = Sheet1.Range("G6")
.Body = "#DO NOT MODIFY FOLLOWING TEXT#" & vbCrLf & "Action:Modify" & vbCrLf & "Server:appdc1" & vbCrLf & "Schema:AP:Signature" & vbCrLf & "Request ID:" & Range("H6") & vbCrLf & "Approval Status!" & vbCrLf & vbCrLf & "Status Template:Approval_By_Email_Status_en" & vbCrLf & "Result Template:Approval_By_Email_Result_Approve_en" & vbCrLf & Range("I6")

.Send


Range("A5:D5000").Select

Selection.ClearContents

End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing

End Sub

 

[dmt32]

Hi,
You can just read the required ranges into an array & use this to populate your variables Update to your code would then look something like this:

 Sub Mail_send_Mail_Outlook()    
    Dim OutApp As Object, OutMail As Object
    Dim strbody As String, strSubject As String
    Dim DataRange As Range
    Dim Data As Variant
    Dim r As Long
    
    With Sheet1
'intialize 2D variant array
        Data = .Range(.Range("G6"), .Range("I" & .Rows.Count).End(xlUp)).Value2
    End With
    
'cycle through each row
    For r = 1 To UBound(Data, 1)
'get subject
        strSubject = Data(r, 1)
'get body text
        strbody = "#DO NOT MODIFY FOLLOWING TEXT#" & vbCrLf & _
                    "Action:Modify" & vbCrLf & _
                    "Server:appdc1" & vbCrLf & _
                    "Schema:AP:Signature" & vbCrLf & _
                    "Request ID:" & Data(r, 2) & vbCrLf & _
                    "Approval Status!" & vbCrLf & vbCrLf & _
                    "Status Template:Approval_By_Email_Status_en" & vbCrLf & _
                    "Result Template:Approval_By_Email_Result_Approve_en" & vbCrLf & Data(r, 3)
        
        On Error Resume Next
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)
        
        With OutMail
            .to = "email@address"
            .subject = strSubject
            .Body = strbody
            .Send
        End With
        
        On Error GoTo 0
'clear from memory
        Set OutMail = Nothing
        Set OutApp = Nothing
    Next r
        
End Sub

Solution reads range G6:I & lastrow into a 2D variant array – Each element of array is then extracted in the For Next Loop to populate your variables.

Solution is untested & I may not have fully understood you requirement correctly but hopefully, you can adjust to meet your project need as required.

Dave

 

[Jacki]

Hey Dave,

That worked a treat! Thanks a bunch for this! A few slight amendments and its up and running!

You are a champ.

Thanks!

Jacki

 

[Jacki]

Is there a way to stop the loop for Column A instead of Column I? (I have formulas in those columns, so the loop continues to run)

 

[dmt32]

Is there a way to stop the loop for Column A instead of Column I? (I have formulas in those columns, so the loop continues to run)

Hi,

change this

    With Sheet1
'intialize 2D variant array
        Data = .Range(.Range("G6"), .Range("I" & .Rows.Count).End(xlUp)).Value2
    End With

to this

       With Sheet1
'intialize 2D variant array
        Data = .Range(.Range("G6"), .Range("I" & .Cells(.Rows.Count, "A").End(xlUp).Row)).Value2
    End With

and see if this does what you want


Dave

 

[Jacki]

Thank you Thank you Dave, that worked perfectly. I really appreciate this

 

[dmt32]

Thank you Thank you Dave, that worked perfectly. I really appreciate this

most welcome - appreciate your feedback


Dave