Macro to show upcoming date

I have a spread sheet with dates running across the columns .e.g H11 = 01/09/12 H12 02/09/12 etc.
The columns have a variety of upcoming events
The cell which corresponds with the event and the date is marked with a letter 'e'

What I'm looking for is that in the G column the most upcoming date for the event is shown e.g. with the event 'Breakfast' which happens once a month I want it the cell in column G to say the next due date e.g. 03/04/12, but once that date has passed I want it to show April's date e.g. 07/04/12 (corresponding to the marked event dates)

Hope that is clear

Thanks

Why use VBA for this? Why not just use a vlookup? For example, if the event "Breakfast" has dates April 3, 2012, May 4 2012 and June 2 2012, create a lookup table:

Column A
1: 3/4/2012
2: 4/5/2012
3: 2/6/2012

Then use a vlookup: "=VLOOKUP(NOW(), $A$1:$A$3, 1)"

Sorry, my formula will show the most recent date. for the upcoming date use:

"=INDEX($A$1:$A$3, MATCH(NOW(), $A$1:$A$3,1)+1)"

Attachment 155030

The above image shows the layout. I don't know if your suggestion would work.
As you can see an E marks that on the 12th of May there is a breakfast event, I was looking for a way that the Earliest Date cell shows what the next upcoming date is for the event row.

Thanks

your attachment didn't come through. Why not just attach the excel file?

test.xlsm

File should be attached.

See attached file. I don't think you need a macro.

test.xlsx

Fantastic, thank you.

Sorry about this addition, looking back I wasn't that clear. Is there a way that the formula can take into account the current date and thus skip over previous event dates? e.g. although a Men's Breakfast was marked for the 2nd of May now that the date has passed I'd like the column to show the June date.

Thanks

Does anyone know if I can modify the formula to take into account the current date and so skip over recording the 'earliest date' that is now in the past, or would I require code?

Thanks

Ok, my second attempt. Notice that I have defined a dynamic range called "Future". Go to the Name Manager to see the definition. Other than that, the formulas are straightforward.

Date Lookup.xlsx

That's exactly what I'm looking for, thanks! I'm just having a few problems transferring the formula across to the workbook which runs macros for the other things it does. I have made sure that I've defined the name in the new sheet but I'm getting an N/A appear even when date is highlighted.

OK, I give up. I've been trying to avoid VBA, but it hasn't worked. Here's a function that should do the trick. Also, here's the workbook.

DateLookup.xlsm

Public Function EventLookup(DateRange As Range, EventRange As Range, _
    Optional FindString As String = "E") As Variant
    
    Application.Volatile
    
    Dim FutureDateRange As Range, FutureEventRange As Range, _
        TodayPosition As Long, EventPosition As Long, Result As Variant
    
    'Set the ranges that refer to dates in the future. If none found, return
    'a VALUE error
    On Error GoTo BadDateRange
    TodayPosition = Application.WorksheetFunction.Match(CLng(Now), DateRange, 1)
    Set FutureDateRange = Range(DateRange.Cells(1, TodayPosition), _
        DateRange.Cells(1, DateRange.Columns.Count))
    Set FutureEventRange = Range(EventRange.Cells(1, TodayPosition), _
        EventRange.Cells(1, EventRange.Columns.Count))
    
    'Look for the event. if no event is found, return #N/A Error
    On Error GoTo NoEvents
    EventPosition = Application.WorksheetFunction.Match(FindString, FutureEventRange, 0)
    Result = FutureDateRange.Cells(1, EventPosition).Value
    EventLookup = Result
    Exit Function
    
BadDateRange:
    EventLookup = CVErr(xlErrValue)
    Exit Function
    
NoEvents:
    EventLookup = CVErr(xlErrNA)
End Function

Both methods you offered were genius, the problem was at my end. Stupid mistake on my behalf I tried transferring code to the latest updated sheet I've made however that sheet begins in Sept '12. Both the formula and the code were throwing a wobbly because everything was in the future and I guess it needs the calendar dates to at least start begin in the past for it to work. That's perfectly fine because I wouldn't be using the spreadsheet until September had begun so there would be no issue.

Thank you once again for your help on this matter it has been greatly appreciated.

Just a query regarding the above code. Is it easy to modify so the code would run with the letter "P" AND the letter "E"? If it would not be easy and would require a massive rewrite don't worry about it, it was just an idea for an additional feature of spreadsheet to note provisional events.

Thanks

Probably the easiest way is just to piggy-back on the existing code, as below. Leave the EventLookup code unchanged, and use a new function to return the minimum (earliest date). For the other solution, the dynamic range solution, you can use an "IFERROR" statement within a cell. Come to think of it, an "IFERROR" statment would also work for the VBA solution, as in '=IFERROR(MIN(EVENTLOOKUP(DateRange, EventRange, "E"), EVENTLOOKUP(DateRange, EventRange, "P")), IFERROR(EVENTLOOKUP(DateRange, EventRange, "E"), EVENTLOOKUP(DateRange, EventRange, "P")))'. Cumbersome, yes, but it should work.

The code below should be easily modified to handle more than just E and P.

Public Function NewLookup(DateRange As Range, EventRange As Range) As Variant
    Dim arrChar(1 To 2) As String, tmpVar As Variant, tmpChar As Variant, Result As Variant
    
    arrChar(1) = "E"
    arrChar(2) = "P"
    
    'Check first if the date range makes sense, if not exit with value error
    tmpVar = EventLookup(DateRange, EventRange, arrChar(1))
    If tmpVar = CVErr(xlErrValue) Then
        NewLookup = CVErr(xlErrValue)
        Exit Function
    End If
    
    'Loop through the possibilities to find the nearest date
    For Each tmpChar In arrChar
        tmpVar = EventLookup(DateRange, EventRange, CStr(tmpChar))
        If Not IsError(tmpVar) Then
            If IsEmpty(Result) Then
                Result = tmpVar
            Else
                Result = Application.WorksheetFunction.Min(tmpVar, Result)
            End If
        End If
    Next tmpChar
    
    'If nothing is found, return #N/A error
    If IsEmpty(Result) Then
        Result = CVErr(xlErrNA)
    End If
    
    NewLookup = Result
End Function

I'm possibly being a bit dense, but I can't seem to get it to work. I've tried adding the code after previous code and adding it as a different module but it doesn't seem to recognize P, then when seeking to use "IFERROR" statement I just get a "VALUE" error. I'm attaching copy of the document with code added after previous event look up code.

Thanks

Paul

I've had another go but can't seem to see what's not working. Any idea?

Thanks

OK, I tried again. You were right, the last one didn't work.

I've included a copy of the worksheet with the events stripped out; the events were causing problems for my version of excel.

Note that there are two ways to use the function. One is to enter an array of possible values in curly braces, the other is to refer to a range of values.

Copy of Planogram 2012-2013.xlsm

Public Function EventLookup(DateRange As Range, EventRange As Range, _
    FindStrings As Variant) As Variant
    
    Dim FutureDateRange As Range, FutureEventRange As Range, _
        TodayPosition As Long, EventPosition As Long, Result As Variant, _
        tmpVariant As Variant, tmpEventPosition As Long
    
    'Set the ranges that refer to dates in the future. If none found, return
    'a VALUE error
    On Error GoTo BadDateRange
    TodayPosition = Application.WorksheetFunction.Match(CLng(Now), DateRange, 1)
    Set FutureDateRange = Range(DateRange.Cells(1, TodayPosition), _
        DateRange.Cells(1, DateRange.Columns.Count))
    Set FutureEventRange = Range(EventRange.Cells(1, TodayPosition), _
        EventRange.Cells(1, EventRange.Columns.Count))
    
    'Look for the event. if no event is found, return #N/A Error
    EventPosition = 999999
    tmpEventPosition = EventPosition
    'FindStrings could be an array or a single value
    If IsArray(FindStrings) Then
        For Each tmpVariant In FindStrings
            On Error Resume Next
            tmpEventPosition = Application.WorksheetFunction.Match(tmpVariant, FutureEventRange, 0)
            On Error GoTo 0
            If tmpEventPosition < EventPosition Then
                EventPosition = tmpEventPosition
            End If
        Next tmpVariant
    Else
        On Error Resume Next
        tmpEventPosition = Application.WorksheetFunction.Match(FindStrings, FutureEventRange, 0)
        On Error GoTo 0
        If tmpEventPosition < EventPosition Then
            EventPosition = tmpEventPosition
        End If
    End If
    
    'If eventposition is larger than the number of columns, then return NA error
    If EventPosition > 16384 Then
        Result = CVErr(xlErrNA)
    Else
        Result = FutureDateRange.Cells(1, EventPosition).Value
    End If
    EventLookup = Result
    Exit Function
    
BadDateRange:
    EventLookup = CVErr(xlErrValue)
    Exit Function
End Function

Brilliant, thank you very much.