Popup to Notify of Expiring/Expired Dates

[RachelHB]

Hello,

I have a spreadsheet with a list of employees names down the left side and each column shows a qualification or cert they have and in the corresponding cell is the date that will expire.

I have managed to do the conditional formatting but i was hoping there would be a way to have a pop up when you first log on showing what has expired and what will expire in 30 days? Not all cells have a date which is causing me some issues.

Alternatively could i do a separate sheet with a pivot table on where i could run a daily report to show what is expired / due to expire?

Because i have so much information for each employee i'm struggling to find the right answer.

Thankyou!

 

[RachelHB]

It needs to go into a standard code module.
Right-click on your workbook name in the "Project-VBAProject" pane (at the top left corner of the editor window) and
select Insert -> Module from the context menu.
Paste the code into this module.

Have you created the CoursesReport worksheet?

What line does the Compile Error come up on?

It's coming up on this line -

Set WsLiveReport = Worksheets("LiveReport")

(I've renamed it Live Report and changed any relevant code to match the name)

The code now looks like this -

Public Sub subLiveReport()
Dim WsLive As Worksheet
Dim WsLiveReport As Worksheet
Dim arrData() As Variant
Dim i As Integer
Dim ii As Integer
Dim intRow As Integer
Dim rngData As Range

ActiveWorkbook.Save

' CHANGE THIS LINE TO INCLUDE YOUR WORKSHEET NAME.
Set WsLive = Worksheets("Live")

Set WsLiveReport = Worksheets("LiveReport")

Set rngData = WsLive.Range("A1:CK11")

arrData = rngData.Value

intRow = 1

WsLiveReport.Cells.ClearContents

For i = LBound(arrData) + 1 To UBound(arrData)

For ii = 32 To 89

With WsLiveReport
If Len(Trim(arrData(i, ii))) > 0 Then
intRow = intRow + 1
.Cells(intRow, 1).Resize(1, 3).Value = Array(arrData(i, 1), arrData(1, ii), arrData(i, ii))
End If
End With

Next ii

Next i

With WsLiveReport

.Sort.SortFields.Clear
.Sort.SortFields.Add2 Key:=Range("C2:C301"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Sort.SortFields.Add2 Key:=Range("B2:B301"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Sort.SortFields.Add2 Key:=Range("A2:A301"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With .Sort
.SetRange Range("A1:C301")
.Orientation = xlTopToBottom
.Header = xlYes
.Apply
End With

End With

With WsLiveReport
.Activate
.Range("A1").Select
With .Range("A1").CurrentRegion
With .Cells(2, 4).Resize(intRow - 1, 1)
.Formula = "=IF(C2<NOW()," & """Expired""" & ",IF(C2<=(NOW()+30)," & """To Expire""" & "," & """""" & "))"
.Value = .Value
End With
End With
End With

With WsLiveReport.Range("A1:D1")
.Value = Array("Name", "Course", "Date", "Status")
.Interior.Color = RGB(217, 217, 217)
.Font.Bold = True
End With

WsLiveReport.Range("A2").Select
If Not ActiveWindow.FreezePanes Then
ActiveWindow.FreezePanes = True
End If

MsgBox "Employee Courses Report Complete.", vbOKOnly, "Confirmation"

End Sub

 

[Herakles]

It's coming up on this line -

Set WsLiveReport = Worksheets("LiveReport")

(I've renamed it Live Report and changed any relevant code to match the name)

The code now looks like this -

Public Sub subLiveReport()
Dim WsLive As Worksheet
Dim WsLiveReport As Worksheet
Dim arrData() As Variant
Dim i As Integer
Dim ii As Integer
Dim intRow As Integer
Dim rngData As Range

ActiveWorkbook.Save

' CHANGE THIS LINE TO INCLUDE YOUR WORKSHEET NAME.
Set WsLive = Worksheets("Live")

Set WsLiveReport = Worksheets("LiveReport")

Set rngData = WsLive.Range("A1:CK11")

arrData = rngData.Value

intRow = 1

WsLiveReport.Cells.ClearContents

For i = LBound(arrData) + 1 To UBound(arrData)

For ii = 32 To 89

With WsLiveReport
If Len(Trim(arrData(i, ii))) > 0 Then
intRow = intRow + 1
.Cells(intRow, 1).Resize(1, 3).Value = Array(arrData(i, 1), arrData(1, ii), arrData(i, ii))
End If
End With

Next ii

Next i

With WsLiveReport

.Sort.SortFields.Clear
.Sort.SortFields.Add2 Key:=Range("C2:C301"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Sort.SortFields.Add2 Key:=Range("B2:B301"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Sort.SortFields.Add2 Key:=Range("A2:A301"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With .Sort
.SetRange Range("A1:C301")
.Orientation = xlTopToBottom
.Header = xlYes
.Apply
End With

End With

With WsLiveReport
.Activate
.Range("A1").Select
With .Range("A1").CurrentRegion
With .Cells(2, 4).Resize(intRow - 1, 1)
.Formula = "=IF(C2<NOW()," & """Expired""" & ",IF(C2<=(NOW()+30)," & """To Expire""" & "," & """""" & "))"
.Value = .Value
End With
End With
End With

With WsLiveReport.Range("A1:D1")
.Value = Array("Name", "Course", "Date", "Status")
.Interior.Color = RGB(217, 217, 217)
.Font.Bold = True
End With

WsLiveReport.Range("A2").Select
If Not ActiveWindow.FreezePanes Then
ActiveWindow.FreezePanes = True
End If

MsgBox "Employee Courses Report Complete.", vbOKOnly, "Confirmation"

End Sub

I have used your code and I've changed the names of the worksheets and have managed to run it without a problem.

Have you created the 'LiveReport' worksheet.