Help with formula to return a value based on if that expiry date is within year

Hi guys,

Not sure if this can be done in a formula or if it will need a macro but I've got the following happening on a sheet:

Column A: List of entries
Column B-L: future dates for each of the values in column A

What I'd like to happen is a formula where if the current year and a year in one of the dates match then the value from column A will be displayed.

So if I look at a sheet it automatically lists the different entries in column A that are 'due' this year..

Hope this makes sense. Any further clarification please do get in touch!

Thanks a lot!

Attach a sample workbook. Make sure there is just enough data to demonstrate your need. Include a BEFORE sheet and an AFTER sheet in the workbook if needed to show the process you're trying to complete or automate. Make sure your desired results are shown, mock them up manually if necessary.

Remember to desensitize the data.

Click on GO ADVANCED and use the paperclip icon to open the upload window.

View Pic

with an filter on column E (and select the year 2015).

See the attached file.

I noticed you have merged cells in your file.

Don't work with merged cells, you get in trouble with it sooner or later.

Or place the below code on ThisWorkbook module.

Private Sub Workbook_Open()
Dim ws As Worksheet
Dim rng As Range, cell As Range
Dim lr As Long, lc As Long, ycnt As Long, i As Long
Set ws = Sheets("Sheet1")
lr = ws.Cells(Rows.Count, 1).End(xlUp).Row
lc = ws.Cells(6, Columns.Count).End(xlToLeft).Column
Set rng = ws.Range(ws.Cells(6, 2), ws.Cells(lr, lc))
Application.ScreenUpdating = False
ws.Rows.Hidden = False
For i = 6 To lr
    Set rng = ws.Range(ws.Cells(i, 2), ws.Cells(i, lc))
    For Each cell In rng
        If Year(cell) = Year(Date) Then ycnt = ycnt + 1
    Next cell
    If ycnt = 0 Then ws.Rows(i).Hidden = True
    ycnt = 0
Next i
Application.ScreenUpdating = True
End Sub

After placing the above code on ThisWorkbook module, save your workbook as Excel-Macro Enabled workbook and then close your workbook. Next time when you open the workbook you will only show the record that have a date which belongs to the current year.

With some helpcolumns and after that index and match.

See the green cells in the attached file.

Much thanks for the compliments.

Glad I could help.

But I want to say that if I had to work with that file, I would just go for the filteroption (option 1).

For your first question => then there will be no actions found, and that's exactly what you want to know.

1) Or do you mean if the data is in another column?

for the second question:

See the formula in F6 and G6,

BTW you may try this. The below code will display the desired entries starting from A18 every time once you open your workbook.
Implement this code as I explained earlier.

Private Sub Workbook_Open()
Dim ws As Worksheet
Dim rng As Range, cell As Range
Dim lr As Long, lc As Long, Alr As Long, ycnt As Long, i As Long, r As Long
Set ws = Sheets("Sheet1")
lr = ws.Cells(Rows.Count, 2).End(xlUp).Row
Alr = ws.Cells(Rows.Count, 1).End(xlUp).Row
lc = ws.Cells(6, Columns.Count).End(xlToLeft).Column
Set rng = ws.Range(ws.Cells(6, 2), ws.Cells(lr, lc))
r = 18  'r is the starting row in col. A where entries will be displayed, so change it as per your need
Application.ScreenUpdating = False
If Alr > 17 Then ws.Range(ws.Cells(18, 1), ws.Cells(Alr, 1)).Clear
For i = 6 To lr
    Set rng = ws.Range(ws.Cells(i, 2), ws.Cells(i, lc))
    For Each cell In rng
        If Year(cell) = Year(Date) Then ycnt = ycnt + 1
    Next cell
    If ycnt > 0 Then
        ws.Range("A" & r) = ws.Cells(i, 1)
        ws.Range("A" & r).Font.Color = vbRed
        ws.Range("A" & r).Font.Bold = True
        ws.Range("A" & r).Font.Size = 12
        ws.Range("A" & r).HorizontalAlignment = xlCenter
        r = r + 1
    End If
    ycnt = 0
Next i
Application.ScreenUpdating = True
End Sub

@mw

Though oeldere has provided you a working solution and I joined after a while so can I ask a question?
Is it always col. E where date belonging to the current year exists or it may by in any column from col. B to unknown number of columns?

Thus, using the file oeldere sent I have screenshotted the issue. I would like the IF function that says 'Yes' for if it is currently equal to the same year to look at the whole row if possible...and if there is a correlation for it to flag up.


Hm doesn't seem to like my png file. Will upload the Excel again.

Please post your file in #16 again, because I can't open it.

See the attached file (the formula is changed in the orange cells).

Here is the code with the comments.....

Private Sub Workbook_Open()
Dim ws As Worksheet
Dim rng As Range, cell As Range
Dim lr As Long, lc As Long, Alr As Long, ycnt As Long, i As Long, r As Long
Set ws = Sheets("Sheet1")
lr = ws.Cells(Rows.Count, 2).End(xlUp).Row               '2 is the column index of first date column, in this case it is 2 for col. B
Alr = ws.Cells(Rows.Count, 1).End(xlUp).Row              '1 is used for the col. A to check the last row with data
lc = ws.Cells(6, Columns.Count).End(xlToLeft).Column                                         ' lc is the last column with date used in row 6
Set rng = ws.Range(ws.Cells(6, 2), ws.Cells(lr, lc))
r = 18                                                   'r is the starting row in col. A where entries will be displayed, so change it as per your need

Application.ScreenUpdating = False
If Alr > 17 Then ws.Range(ws.Cells(18, 1), ws.Cells(Alr, 1)).Clear 'Clears result every time before displaying them again.
For i = 6 To lr                                          ' i = 6 means that the actual data starts from row 6
    Set rng = ws.Range(ws.Cells(i, 2), ws.Cells(i, lc))  ' sets range to have all the dates in a row, it will check for dates up to the last column.
    For Each cell In rng
        If Year(cell) = Year(Date) Then ycnt = ycnt + 1
    Next cell
    If ycnt > 0 Then
        ws.Range("A" & r) = ws.Cells(i, 1)               ' This will be the first cell in this case it is A18 where the output will be placed.
        ws.Range("A" & r).Font.Color = vbRed             ' These four lines are for the format of the result cells.
        ws.Range("A" & r).Font.Bold = True
        ws.Range("A" & r).Font.Size = 12
        ws.Range("A" & r).HorizontalAlignment = xlCenter
        r = r + 1
    End If
    ycnt = 0
Next i
Application.ScreenUpdating = True
End Sub

As per your sample workbook, since you want to show the result on row 18 onwards, so you can have max 16 rows for actual data.
The code looks for last column used in a row with date, so it will check the entire row for the dates.

Please make the changes in the code as per your requirement if any.

Duplicate post..

You're welcome mw and thanks for the feedback as well.

Also if you are happy with the solution, edit your thread title and change the smiley used there.