abraham30
01-09-2017, 04:40 AM
Hi,
I have created a macro that will alert 70 days prior to the date available in column J. When I have used the same macro in some other sheet, it is working where as it is not working with this sheet.
Can anyone guide me in which part I made the mistake.
Sub ABCDEFG()
Dim rc1, rc2 As Long
Dim sht1 As String
sht1 = "GSK"
rc1 = ActiveWorkbook.Sheets(sht1).UsedRange.Columns.Count
If ActiveWorkbook.Sheets(sht1).AutoFilterMode Then ActiveSheet.AutoFilter.ShowAllData
Dim i As Long
For i = 14 To rc1
If ((ActiveWorkbook.Worksheets(sht1).Cells(i, 7) = "PSUR" Or ActiveWorkbook.Worksheets(sht1).Cells(i, 7) = "EU PSUR" Or _
ActiveWorkbook.Worksheets(sht1).Cells(i, 7) = "PBRER") And ActiveWorkbook.Worksheets(sht1).Cells(i, 31) = "" And _
ActiveWorkbook.Worksheets(sht1).Cells(i, 33) = "" And Trim(ActiveWorkbook.Worksheets(sht1).Cells(i, 10)) >= Date And _
Trim(ActiveWorkbook.Worksheets(sht1).Cells(i, 10)) <= Date + 70) Then
Call Fire_mail(i, "Alert Email")
End If
Next i
End Sub
Private Sub Fire_mail(x As Long, str As String)
Dim App As Object
Dim item As Object
Dim sMsgBody As String
Dim sht1
sht1 = "GSK"
On Error GoTo ***
If (str = "Alert Email") Then
esubject = ActiveWorkbook.Worksheets(sht1).Cells(x, 3) & " Product/License Configuration File and Missing data"
sMsgBody = "Dear friend" & "," & vbCr & vbCr
sMsgBody = sMsgBody & "Please update me on the below GSK product" & vbCr & vbCr
sMsgBody = sMsgBody & "Regards" & vbCr & vbCr
sMsgBody = sMsgBody & "ON BEHALF OF GSK"
ebody = sMsgBody
End If
sendto = ActiveWorkbook.Worksheets(sht1).Cells(x, 57)
ccto = "ABCD@XAX.COM"
Set App = CreateObject("Outlook.Application")
Set itm = App.CreateItem(olMailItem)
With itm
.Subject = esubject
.To = sendto
.CC = ccto
.Body = ebody
.Display
End With
Set App = Nothing
Set itm = Nothing
***:
End Sub
I have created a macro that will alert 70 days prior to the date available in column J. When I have used the same macro in some other sheet, it is working where as it is not working with this sheet.
Can anyone guide me in which part I made the mistake.
Sub ABCDEFG()
Dim rc1, rc2 As Long
Dim sht1 As String
sht1 = "GSK"
rc1 = ActiveWorkbook.Sheets(sht1).UsedRange.Columns.Count
If ActiveWorkbook.Sheets(sht1).AutoFilterMode Then ActiveSheet.AutoFilter.ShowAllData
Dim i As Long
For i = 14 To rc1
If ((ActiveWorkbook.Worksheets(sht1).Cells(i, 7) = "PSUR" Or ActiveWorkbook.Worksheets(sht1).Cells(i, 7) = "EU PSUR" Or _
ActiveWorkbook.Worksheets(sht1).Cells(i, 7) = "PBRER") And ActiveWorkbook.Worksheets(sht1).Cells(i, 31) = "" And _
ActiveWorkbook.Worksheets(sht1).Cells(i, 33) = "" And Trim(ActiveWorkbook.Worksheets(sht1).Cells(i, 10)) >= Date And _
Trim(ActiveWorkbook.Worksheets(sht1).Cells(i, 10)) <= Date + 70) Then
Call Fire_mail(i, "Alert Email")
End If
Next i
End Sub
Private Sub Fire_mail(x As Long, str As String)
Dim App As Object
Dim item As Object
Dim sMsgBody As String
Dim sht1
sht1 = "GSK"
On Error GoTo ***
If (str = "Alert Email") Then
esubject = ActiveWorkbook.Worksheets(sht1).Cells(x, 3) & " Product/License Configuration File and Missing data"
sMsgBody = "Dear friend" & "," & vbCr & vbCr
sMsgBody = sMsgBody & "Please update me on the below GSK product" & vbCr & vbCr
sMsgBody = sMsgBody & "Regards" & vbCr & vbCr
sMsgBody = sMsgBody & "ON BEHALF OF GSK"
ebody = sMsgBody
End If
sendto = ActiveWorkbook.Worksheets(sht1).Cells(x, 57)
ccto = "ABCD@XAX.COM"
Set App = CreateObject("Outlook.Application")
Set itm = App.CreateItem(olMailItem)
With itm
.Subject = esubject
.To = sendto
.CC = ccto
.Body = ebody
.Display
End With
Set App = Nothing
Set itm = Nothing
***:
End Sub