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!

 

[My Aswer Is This]

You said:
down the left side and each column

Well excel has about 2,000 columns.
Are you sure you have down the left side of each column?

Which column and left side of column? so what is down the right side of the column?

 

[RachelHB]

You said:
down the left side and each column

Well excel has about 2,000 columns.
Are you sure you have down the left side of each column?

Which column and left side of column? so what is down the right side of the column?

Apologies, let me explain better.

Cells A1-A303 lists each employee. Then columns AF-CK each represent a separate certificate/qualification.

 

[My Aswer Is This]

So you have one column column A with names
And 57 columns with certifications.
so we need to check all 57 columns for some date
Is this correct?

 

[RachelHB]

So you have one column column A with names
And 57 columns with certifications.
so we need to check all 57 columns for some date
Is this correct?

Yes please

 

[My Aswer Is This]

Yes please

And do what?
You said: to have a pop up
What is a popup?
Checking this large a range and having a popup
If you mean have a Message Box popup what would it say?

Details Details we always need specific details.

 

[Herakles]

This code will transform your data so that it is easy to see what you want to see.

This code will take your data and create a list in a worksheet called "CoursesReport" which you will need to create.

I have assumed that the worksheet with the data in is called 'Courses' but you will need to change this where indicated in the code.

As far as a popup is concerned, look at this and then decide what will work.

You probably have more employee related data, do you need any of this on the CoursesReport worksheet?

Run this on a copy of your data.

Public Sub subCoursesReport()
Dim WsCourses As Worksheet
Dim WsCoursesReport 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 WsCourses = Worksheets("Courses")
    
    Set WsCoursesReport = Worksheets("CoursesReport")
            
    Set rngData = WsCourses.Range("A1:CK11")
            
    arrData = rngData.Value
        
    intRow = 1
    
    WsCoursesReport.Cells.ClearContents
    
    For i = LBound(arrData) + 1 To UBound(arrData)
        
        For ii = 32 To 89
            
                With WsCoursesReport
                    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 WsCoursesReport
    
        .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 WsCoursesReport
        .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 WsCoursesReport.Range("A1:D1")
        .Value = Array("Name", "Course", "Date", "Status")
        .Interior.Color = RGB(217, 217, 217)
        .Font.Bold = True
    End With
    
    WsCoursesReport.Range("A2").Select
    If Not ActiveWindow.FreezePanes Then
        ActiveWindow.FreezePanes = True
    End If
    
    MsgBox "Employee Courses Report Complete.", vbOKOnly, "Confirmation"

End Sub

 

[RachelHB]

This code will transform your data so that it is easy to see what you want to see.

This code will take your data and create a list in a worksheet called "CoursesReport" which you will need to create.

I have assumed that the worksheet with the data in is called 'Courses' but you will need to change this where indicated in the code.

As far as a popup is concerned, look at this and then decide what will work.

You probably have more employee related data, do you need any of this on the CoursesReport worksheet?

Run this on a copy of your data.

Public Sub subCoursesReport()
Dim WsCourses As Worksheet
Dim WsCoursesReport 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 WsCourses = Worksheets("Courses")
   
    Set WsCoursesReport = Worksheets("CoursesReport")
           
    Set rngData = WsCourses.Range("A1:CK11")
           
    arrData = rngData.Value
       
    intRow = 1
   
    WsCoursesReport.Cells.ClearContents
   
    For i = LBound(arrData) + 1 To UBound(arrData)
       
        For ii = 32 To 89
           
                With WsCoursesReport
                    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 WsCoursesReport
   
        .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 WsCoursesReport
        .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 WsCoursesReport.Range("A1:D1")
        .Value = Array("Name", "Course", "Date", "Status")
        .Interior.Color = RGB(217, 217, 217)
        .Font.Bold = True
    End With
   
    WsCoursesReport.Range("A2").Select
    If Not ActiveWindow.FreezePanes Then
        ActiveWindow.FreezePanes = True
    End If
   
    MsgBox "Employee Courses Report Complete.", vbOKOnly, "Confirmation"

End Sub

Hey, thanks for the reply.

Is this just a case of opening VBA and adding the code on a sheet? as ive done this but it doesnt do anything when pressing run. I just get an error message - Compile Error

 

[RachelHB]

And do what?
You said: to have a pop up
What is a popup?
Checking this large a range and having a popup
If you mean have a Message Box popup what would it say?

Details Details we always need specific details.

Yes a message box. As per my first message which will state which certs have expired if possible.

 

[Herakles]

Hey, thanks for the reply.

Is this just a case of opening VBA and adding the code on a sheet? as ive done this but it doesnt do anything when pressing run. I just get an error message - Compile Error

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?