Hi, Raja Kamarthi!
Let me change the things a little bit:
a) Mandatory documents should have an "(*)" -unquoted- at the end of description in row 1, e.g., "Passport (*)", "Driving License".
b) Non existent document numbers should have columns "Number" and "Expiry date" in blank
c) Formula for "No.of Months for Expiry" changes from:
=(G3-HOY())/30 -----> in english: =(G3-TODAY())/30
to:
=SI(ESBLANCO(F3);SI(ESERROR(HALLAR("(*)";F$1));"";"N/A");(G3-HOY())/30) -----> in english: =IF(ISBLANK(F3),IF(ISERROR(SEARCH("(*)",F$1)),"","N/A"),(G3-TODAY())/30)
so yo have to enter anything like "N/A" and hence avoiding errors (no, I don't trust in users, neither on MIS people)
d) I added two empty columns before those weird columns "BOSIET" & "HUET" so as to standardize the column distribution, 3 for each, it doesn't follow Codd's 12 postulates but's the better I could figure out. You can hide them later if you wish.
e) That let me apply a unique formula for conditional formatting to highlight "N/A" entries (red):
=Y($A1<>"";COLUMNA()>=6;INDICE($A:$BA;FILA();COLUMNA()+2-RESIDUO(COLUMNA()-6;3))="N/A") -----> in english: =AND($A1<>"",COLUMN()>=6,INDEX($A:$BA,ROW(),COLUMN()+2-MOD(COLUMN()-6,3))="N/A")
another for mandatory within expiration limits (orange):
=Y($A1<>"";FILA()>1;COLUMNA()>=6;DERECHA(INDICE($A:$BA;1;COLUMNA()-RESIDUO(COLUMNA()-6;3));3)="(*)";INDICE($A:$BA;FILA();COLUMNA()+2-RESIDUO(COLUMNA()-6;3))<=1) -----> in english: =AND($A1<>"",ROW()>1,COLUMN()>=6,RIGHT(INDEX($A:$BA,1,COLUMN()-MOD(COLUMN()-6,3)),3)="(*)",INDEX($A:$BA,ROW(),COLUMN()+2-MOD(COLUMN()-6,3))<=1)
and another for non mandatory within period (yellow):
=Y($A1<>"";FILA()>1;COLUMNA()>=6;DERECHA(INDICE($A:$BA;1;COLUMNA()-RESIDUO(COLUMNA()-6;3));3)<>"(*)";INDICE($A:$BA;FILA();COLUMNA()+2-RESIDUO(COLUMNA()-6;3))<=1) -----> in english: =AND($A1<>"",ROW()>1,COLUMN()>=6,RIGHT(INDEX($A:$BA,1,COLUMN()-MOD(COLUMN()-6,3)),3)<>"(*)",INDEX($A:$BA,ROW(),COLUMN()+2-MOD(COLUMN()-6,3))<=1)
applied to columns $F:$BA
f) I excluded non mandatory blank (but kept those expired) documents from being included in the mail and profiting the 3 and half normal form of your database I simplified macro code as follows:
-----
Option Explicit
Sub PreExpirationMails(pbSend As Boolean)
' constants
Const ksWS = "Sheet1"
Const ksData = "DataTable"
Const ksHeaderID = "Expiry date"
Const kiHeaderNumber = -1
Const kiHeaderName = -1
Const kiLimit = 30
Const ksMandatoryInexistent = "N/A"
Const ksSeparator = " - "
Const ksSubject = "Documents expiration"
Const ksText1 = "Dear sir/madame:"
Const ksText2 = "These documents have expired or expire within " & kiLimit & " days."
Const ksText3 = "Signed by XXX."
' declarations
Dim rng As Range
Dim olApp As Object, olMail As Object
Dim I As Integer, J As Integer, bOk As Boolean
Dim A As String, sMail As String, sText As String
' start
Set rng = Worksheets(ksWS).Range(ksData)
Set olApp = CreateObject("Outlook.Application"
' process
With rng
For I = 1 To .Rows.Count
A = ""
For J = 1 To .Columns.Count
If .Cells(0, J).Value = ksHeaderID Then
bOk = False>If .Cells(I, J + 1).Value = ksMandatoryInexistent Then
bOk = True
Else
If .Cells(I, J).Value <> "" Then
If .Cells(I, J).Value - Int(Now()) < kiLimit Then bOk = True
End If
End If
If bOk Then
If Len(A) <> 0 Then A = A & vbCrLf
A = A & .Cells(-1, J + kiHeaderName).Value & ksSeparator & _
.Cells(I, J + kiHeaderNumber).Value & ksSeparator & _
Format(.Cells(I, J).Value, "dd/mmm/yyyy"
End If
End If
Next J
If A <> "" Then
Set olMail = olApp.CreateItem(0)
sMail = .Cells(I, 5).Value
sText = ksText1 & vbCrLf & _
.Cells(I, 1).Value & vbCrLf & _
.Cells(I, 2).Value & vbCrLf & _
.Cells(I, 3).Value & vbCrLf & _
.Cells(I, 4).Value & vbCrLf & vbCrLf & _
ksText2 & vbCrLf & _
A & vbCrLf & vbCrLf & _
ksText3
'=====
'This block of code written by Ron de Bruin, copied from
'http://msdn.microsoft.com/en-us/library/ff458119(office.11).aspx#odc_office_UseExcelObjectModeltoSendMail_Introduction
On Error Resume Next
' Change the body and subject in the macro before you run it.
With olMail
.To = sMail
.CC = ""
.BCC = ""
.Subject = ksSubject
.Body = sText
'You're not sending an attachment, so I commented this out
'.Attachments.Add ActiveWorkbook.FullName
' You can add other files by uncommenting the following line.
'.Attachments.Add ("C:test.txt"
' In place of the following statement, you can use ".Display" to
' display the mail.
If pbSend Then .Send Else .Display
DoEvents
End With
On Error GoTo 0
'=======
Set olMail = Nothing
End If
Next I
End With
' end
Set olApp = Nothing
Beep
End Sub
-----
Download again the file from this link (same as previous):
https://dl.dropboxusercontent.com/u/60558749/Help%20on%20VBA%20Scripting%20-%20Employee%20Database%20%28for%20Raja%20Kamarthi%20at%20chandoo.org%29.xlsm
BTW, new people in original list of employees?
Regards!
