VBA Email Reference Dynamic Cell

[eddieum1]

Hi there,

I'm trying to send an email through VBA and want the body message to reference a cell in sheet that is based on a dynamic row & column. For example, one email to reference cell B2 if the header row is named ABC and first column is named XYZ. Another email would reference cell D5 if header row is named DEF and first column named UVW. Below is the code that I'm stuck on. Can someone guide me in the right direction? Any help would be appreciated.


Sub mail2()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim FindRow As Range
Dim FindColumn As Range

On Error GoTo cleanup

Set OutApp = CreateObject("Outlook.Application")

For Each cell In Sheets("Sheet1").Range("D1", Range("D1").End(xlDown))
i = cell.row

Set OutMail = OutApp.CreateItem(0)

On Error GoTo cleanup

With Sheets("Sheet2").Rows(1)
Set FindColumn = .Find(Sheets("Sheet1").Range("G" & i).Value, LookAt:=xlPart, MatchCase:=False, SearchFormat:=False)
End With

With Sheets("Sheet2").Columns(1)
Set FindRow = .Find(Sheets("Sheet1").Range("F" & i).Value, LookAt:=xlPart, MatchCase:=False, SearchFormat:=False)
End With


'Stuck after here... I want to get the row # from FindRow and column # from FindColumn in order to create a cell to reference the text in the body of the each email loop


On Error GoTo cleanup

With Application
.EnableEvents = False
.ScreenUpdating = False
End With

On Error Resume Next
With OutMail
.Display
.To = 'emailaddress
.Subject = Hello
.HTMLBody = 'want to add the cell reference here & .HTMLBody
.Send
End With

On Error GoTo 0

Set OutMail = Nothing
Next cell

cleanup:
Set OutApp = Nothing
Application.DisplayAlerts = False
Application.DisplayAlerts = True

With Application
.EnableEvents = True
.ScreenUpdating = True
End With

End Sub

 

[Muhammad_Usman]

It looks like you want to send emails using Outlook based on data from two sheets, "Sheet1" and "Sheet2," and reference cell values in the body of each email. Your code is on the right track, but it seems to have some issues. Here's a modified version of your code with explanations and improvements:

Sub mail2()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range
    Dim FindRow As Range
    Dim FindColumn As Range
    Dim i As Long
    
    On Error GoTo cleanup
    
    Set OutApp = CreateObject("Outlook.Application")
    
    For Each cell In Sheets("Sheet1").Range("D1:D" & Sheets("Sheet1").Cells(Rows.Count, "D").End(xlUp).Row)
        i = cell.Row
        
        Set OutMail = OutApp.CreateItem(0)
        
        On Error GoTo cleanup
        
        ' Find the matching column value in Sheet2
        With Sheets("Sheet2").Rows(1)
            Set FindColumn = .Find(Sheets("Sheet1").Range("G" & i).Value, LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
        End With
        
        ' Find the matching row value in Sheet2
        With Sheets("Sheet2").Columns(1)
            Set FindRow = .Find(Sheets("Sheet1").Range("F" & i).Value, LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
        End With
        
        ' Check if both FindColumn and FindRow are not Nothing
        If Not FindColumn Is Nothing And Not FindRow Is Nothing Then
            ' Create a reference to the cell in Sheet2 using FindRow and FindColumn
            Dim cellReference As String
            cellReference = Sheets("Sheet2").Cells(FindRow.Row, FindColumn.Column).Value
            
            ' Send the email
            On Error Resume Next
            With OutMail
                .Display
                .To = 'emailaddress
                .Subject = "Hello"
                .HTMLBody = "Reference: " & cellReference ' Add the cell reference in the email body
                .Send
            End With
            On Error GoTo 0
        End If
        
        Set OutMail = Nothing
    Next cell


cleanup:
    Set OutApp = Nothing
    Application.DisplayAlerts = False
    Application.DisplayAlerts = True
    
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

In this code:

1. We loop through the cells in column D of "Sheet1" to process each email.
2. We search for matching values in "Sheet2" based on columns G and F.
3. If both FindColumn and FindRow are found, we create a cell reference using `FindRow` and `FindColumn`.
4. We send the email with the cell reference in the HTMLBody.

Make sure to replace `'emailaddress` with the actual email address you want to send the emails to.

Please adapt the code as needed for your specific use case.

 

[eddieum1]

It looks like you want to send emails using Outlook based on data from two sheets, "Sheet1" and "Sheet2," and reference cell values in the body of each email. Your code is on the right track, but it seems to have some issues. Here's a modified version of your code with explanations and improvements:

Sub mail2()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range
    Dim FindRow As Range
    Dim FindColumn As Range
    Dim i As Long
   
    On Error GoTo cleanup
   
    Set OutApp = CreateObject("Outlook.Application")
   
    For Each cell In Sheets("Sheet1").Range("D1:D" & Sheets("Sheet1").Cells(Rows.Count, "D").End(xlUp).Row)
        i = cell.Row
       
        Set OutMail = OutApp.CreateItem(0)
       
        On Error GoTo cleanup
       
        ' Find the matching column value in Sheet2
        With Sheets("Sheet2").Rows(1)
            Set FindColumn = .Find(Sheets("Sheet1").Range("G" & i).Value, LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
        End With
       
        ' Find the matching row value in Sheet2
        With Sheets("Sheet2").Columns(1)
            Set FindRow = .Find(Sheets("Sheet1").Range("F" & i).Value, LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
        End With
       
        ' Check if both FindColumn and FindRow are not Nothing
        If Not FindColumn Is Nothing And Not FindRow Is Nothing Then
            ' Create a reference to the cell in Sheet2 using FindRow and FindColumn
            Dim cellReference As String
            cellReference = Sheets("Sheet2").Cells(FindRow.Row, FindColumn.Column).Value
           
            ' Send the email
            On Error Resume Next
            With OutMail
                .Display
                .To = 'emailaddress
                .Subject = "Hello"
                .HTMLBody = "Reference: " & cellReference ' Add the cell reference in the email body
                .Send
            End With
            On Error GoTo 0
        End If
       
        Set OutMail = Nothing
    Next cell


cleanup:
    Set OutApp = Nothing
    Application.DisplayAlerts = False
    Application.DisplayAlerts = True
   
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

In this code:

1. We loop through the cells in column D of "Sheet1" to process each email.
2. We search for matching values in "Sheet2" based on columns G and F.
3. If both FindColumn and FindRow are found, we create a cell reference using `FindRow` and `FindColumn`.
4. We send the email with the cell reference in the HTMLBody.

Make sure to replace `'emailaddress` with the actual email address you want to send the emails to.

Please adapt the code as needed for your specific use case.

 

[eddieum1]

Thank you so much! Really appreciate the help