Joe4, for some reason the icon bar in the reply window was greyed out yesterday but this morning it is slightly green for me.
Thanks for the clear instructions. Now I won't violate any rules and I can let you see the complete code.
Would you be able to assist me with further? I pasted a portion of a prior post that I titled
"ADJUSTING RANGE FROM COLUMN A THRU C...(NOT JUST COLUMN A)" down below for you to see.
I've also attached an image of my spreadsheet. Columns A, B, C and L are the focus.
Here is what this code does:
1) Generates 2 different type of emails based on two texts in column L: "Expired" and "Expiring Soon"
2) It brings the data (insurance company name) from column A of the spreadsheet onto the body of the email. One email for all the rows that show "Expired", and another email for all the rows that show "Expiring Soon".
I NEED THE DATA THAT SHOWS UP ON THE EMAIL BODY TO BE FROM COLUMN A, B, AND C OF EACH ROW. WHICH WOULD BE THE INSURANCE CO. NAME (A), THE TYPE OF INSURANCE COVERAGE (B), AND THE ACCOUNT NUMBER (D), NOT JUST COLUMN A.
VBA Code:
Private Sub Workbook_Open()
Dim Instrument1 As String
Dim Instrument2 As String
Dim ws As Worksheet
Dim Status As String
Set ws = Sheets("Renewal Log")
lr = ws.Range("A" & Rows.Count).End(xlUp).Row
' MsgBox "This code ran at Excel start!"
' On Error Resume Next
' If Target.Cells.Count > 1 Then Exit Sub
counter1 = 0
counter2 = 0
On Error Resume Next
For i = 2 To lr
Status = ws.Range("L" & i).Value
If Status = "Expiring Soon" Then
Instrument1 = Instrument1 & ws.Range("A" & i).Value & ", "
counter1 = counter1 + 1
End If
If Status = "Expired" Then
Instrument2 = Instrument2 & ws.Range("A" & i).Value & ", "
counter2 = counter2 + 1
End If
Next i
If counter1 > 0 And counter1 = 1 Then Mail_Expiring_Soon_Outlook Left(Instrument1, Len(Instrument1) - 2)
If counter1 > 0 And counter1 > 1 Then Mail_Expiring_Soon_Outlook Left(Instrument1, Len(Instrument1) - 1)
If counter2 > 0 And counter2 = 1 Then Mail_Expired_Outlook Left(Instrument2, Len(Instrument2) - 2)
If counter2 > 0 And counter2 > 1 Then Mail_Expired_Outlook Left(Instrument2, Len(Instrument2) - 1)
End Sub
Sub Mail_Expiring_Soon_Outlook(Instrument1 As String)
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
xMailBody = "Attention" & vbNewLine & vbNewLine & _
"The " & Instrument1 & " renewal is due soon." & vbNewLine & vbNewLine & _
"Please arrange for review or payment."
On Error Resume Next
With xOutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = "Renewal date is approaching"
.Body = xMailBody
.Display 'or use .Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub
Sub Mail_Expired_Outlook(Instrument2 As String)
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
xMailBody = "Warning!" & vbNewLine & vbNewLine & _
"The " & Instrument2 & " Registration/Coverage/License is expired." & vbNewLine & vbNewLine & _
"Please arrange for review or payment."
On Error Resume Next
With xOutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = "Warning! Registration/Coverage/License is Expired"
.Body = xMailBody
.Display 'or use .Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub
Thank you so much! Juicy,
