Expiry date help

[Lemmo86]

Hi,

I wonder if anyone can help,

I would like to extract expiry dates and dates that are coming up in the next 4 month to 2 different worksheets.

I have conditional formatting to show what’s expired but want to pull the name and course that has and is expiring to the two worksheets.

Names are in column an and the courses are in columns d to p with the date against everyone names under the correct course columns. I created a table and called it table 2 if that helps.

Please help.

 

[Joe4]

The structure as your data is really not conducive to that (which is why you are having so much trouble).
You want to return:
- Column 1: the name from column A
- Column 2: the name of the course form row 1
- Column 3: the corresponding date for the intersection of the first two things above if the date falls within the next 4 months

Maybe there are some tricks using the some of the new Excel functions introduced in Excel 365, but I cannot think of any myself.
The only way I would be able to do this is with some VBA code. Are you open to a VBA solution?

If so, where do you want the results?
You mentioned two separate worksheets to send the results to.
So how do we know which ones to send where?

 

[Lemmo86]

I would like a summary like page, which will return name, course and date expiring in the next four months. I can change the format if needed. I did think about a drop down for each course.

 

[Lemmo86]

The structure as your data is really not conducive to that (which is why you are having so much trouble).
You want to return:
- Column 1: the name from column A
- Column 2: the name of the course form row 1
- Column 3: the corresponding date for the intersection of the first two things above if the date falls within the next 4 months

Maybe there are some tricks using the some of the new Excel functions introduced in Excel 365, but I cannot think of any myself.
The only way I would be able to do this is with some VBA code. Are you open to a VBA solution?

If so, where do you want the results?
You mentioned two separate worksheets to send the results to.
So how do we know which ones to send where?

I am no good with VBA so sheet one would be called expired and sheet two would be called expiring.

 

[Joe4]

What is the name of the sheet where this original data resides on?

 

[Lemmo86]

What is the name of the sheet where this original data resides on?

Skills matrix

 

[Joe4]

Skills matrix

OK. I will need a little bit of time to come up with the code for you.

 

[Lemmo86]

OK. I will need a little bit of time to come up with the code for you.

Thank you for all your help

 

[Joe4]

OK, try this code (be sure to insert a new module in your workbook and put it there, and not put it in any of the sheet modules):

Sub MyDataCopier()

    Dim wsSrc As Worksheet
    Dim wsExpired As Worksheet
    Dim wsExpiring As Worksheet
    Dim lr As Long
    Dim lc As Long
    Dim r As Long
    Dim c As Long
    Dim re1 As Long
    Dim re2 As Long
    Dim dt1 As Date
    Dim dt2 As Date
    
    Application.ScreenUpdating = False
    
'   Set worksheet objects
    Set wsSrc = Sheets("Skills Matrix")
    Set wsExpired = Sheets("Expired")
    Set wsExpiring = Sheets("Expiring")
    
'   Set date values
    dt1 = Date
    dt2 = Application.WorksheetFunction.EDate(dt1, 4)
    
'   Find last column and rows with data on source sheet
    lr = wsSrc.Cells(wsSrc.Rows.Count, "A").End(xlUp).Row
    lc = wsSrc.Cells(1, wsSrc.Columns.Count).End(xlToLeft).Column
    
'   Place headers on other sheets and initialize counters
    wsExpired.Range("A1") = "Name"
    wsExpired.Range("B1") = "Course"
    wsExpired.Range("C1") = "Expiration Date"
    wsExpiring.Range("A1") = "Name"
    wsExpiring.Range("B1") = "Course"
    wsExpiring.Range("C1") = "Expiration Date"
    re1 = 2
    re2 = 2
    
'   Loop through all rows and columns, starting with C2 on source sheet
    wsSrc.Activate
    For r = 2 To lr
        For c = 3 To lc
'           See if date is expired
            If (wsSrc.Cells(r, c) <> "") And (wsSrc.Cells(r, c) < dt1) Then
'               Copy data to expired sheet
                wsExpired.Cells(re1, 1) = wsSrc.Cells(r, 1) 'Name
                wsExpired.Cells(re1, 2) = wsSrc.Cells(1, c) 'Course
                wsExpired.Cells(re1, 3) = wsSrc.Cells(r, c) 'Expiration date
'               Increment counter
                re1 = re1 + 1
            Else
'               See if date is expiing
                If (wsSrc.Cells(r, c) <> "") And (wsSrc.Cells(r, c) >= dt1) And (wsSrc.Cells(r, c) <= dt2) Then
'                   Copy data to expiring sheet
                    wsExpiring.Cells(re2, 1) = wsSrc.Cells(r, 1) 'Name
                    wsExpiring.Cells(re2, 2) = wsSrc.Cells(1, c) 'Course
                    wsExpiring.Cells(re2, 3) = wsSrc.Cells(r, c) 'Expiration date
'                   Increment counter
                    re2 = re2 + 1
                End If
            End If
        Next c
    Next r
    
    Application.ScreenUpdating = True
    
    MsgBox "Macro complete!"
    
End Sub

 

[Lemmo86]

OK, try this code (be sure to insert a new module in your workbook and put it there, and not put it in any of the sheet modules):

Sub MyDataCopier()

    Dim wsSrc As Worksheet
    Dim wsExpired As Worksheet
    Dim wsExpiring As Worksheet
    Dim lr As Long
    Dim lc As Long
    Dim r As Long
    Dim c As Long
    Dim re1 As Long
    Dim re2 As Long
    Dim dt1 As Date
    Dim dt2 As Date
 
    Application.ScreenUpdating = False
 
'   Set worksheet objects
    Set wsSrc = Sheets("Skills Matrix")
    Set wsExpired = Sheets("Expired")
    Set wsExpiring = Sheets("Expiring")
 
'   Set date values
    dt1 = Date
    dt2 = Application.WorksheetFunction.EDate(dt1, 4)
 
'   Find last column and rows with data on source sheet
    lr = wsSrc.Cells(wsSrc.Rows.Count, "A").End(xlUp).Row
    lc = wsSrc.Cells(1, wsSrc.Columns.Count).End(xlToLeft).Column
 
'   Place headers on other sheets and initialize counters
    wsExpired.Range("A1") = "Name"
    wsExpired.Range("B1") = "Course"
    wsExpired.Range("C1") = "Expiration Date"
    wsExpiring.Range("A1") = "Name"
    wsExpiring.Range("B1") = "Course"
    wsExpiring.Range("C1") = "Expiration Date"
    re1 = 2
    re2 = 2
 
'   Loop through all rows and columns, starting with C2 on source sheet
    wsSrc.Activate
    For r = 2 To lr
        For c = 3 To lc
'           See if date is expired
            If (wsSrc.Cells(r, c) <> "") And (wsSrc.Cells(r, c) < dt1) Then
'               Copy data to expired sheet
                wsExpired.Cells(re1, 1) = wsSrc.Cells(r, 1) 'Name
                wsExpired.Cells(re1, 2) = wsSrc.Cells(1, c) 'Course
                wsExpired.Cells(re1, 3) = wsSrc.Cells(r, c) 'Expiration date
'               Increment counter
                re1 = re1 + 1
            Else
'               See if date is expiing
                If (wsSrc.Cells(r, c) <> "") And (wsSrc.Cells(r, c) >= dt1) And (wsSrc.Cells(r, c) <= dt2) Then
'                   Copy data to expiring sheet
                    wsExpiring.Cells(re2, 1) = wsSrc.Cells(r, 1) 'Name
                    wsExpiring.Cells(re2, 2) = wsSrc.Cells(1, c) 'Course
                    wsExpiring.Cells(re2, 3) = wsSrc.Cells(r, c) 'Expiration date
'                   Increment counter
                    re2 = re2 + 1
                End If
            End If
        Next c
    Next r
 
    Application.ScreenUpdating = True
 
    MsgBox "Macro complete!"
 
End Sub

OMG thank you so much!!!! This worked. I have been trying since Thursday to think of ways to get it to work. One quick question if I need to add new names and new courses, will the code still work?

 

[Joe4]

OMG thank you so much!!!! This worked. I have been trying since Thursday to think of ways to get it to work. One quick question if I need to add new names and new courses, will the code still work?

You are welcome.

Yes, it should, as it dynamically finds the last row and column.