Locating nearest date match

[sts023]

Hi guys....

I have a range on an Excel 2010 worksheet, currently B26:B208.
This range contains date values, each of which is generated by a cell formula which generates the date of the first day of the month after the previous cell (e.g B26 is 01/04/2005, B27 is 01/05/2005, B28 is 01/06/2005 etc.)

There is data in the cells above row 26, some of which are blank, some contain text, and others are merged along the row.

Other working VBA generates a string target date e.g. "02/10/2016".

I need to use VBA to find the address of the cell which has a date equal to or greater than the target date (in my example, this should recover 01/11/2016 at B165).

I know I could code a loop checking each cell, and exiting on an "equal to or greater than" condition, but this seems a bit crude and processing intensive.

The following code shows my attempts, together with details of each failure.

Can anyone help me achieve my aim?

Note:- The data is in ascending sequence, due to the nature of the formula in each cell.

The cells are formatted as “Date *14/03/2001”, (European), which may be a significant factor. My Users are not prepared to accept any solution using American date formats.

Option Explicit
Public Sub Samplecode()
'*
'** Find the nearest match to a date.
'*
Dim strMatchDate                As String
Dim strRng                      As String
Dim strWS                       As String
Dim varDate                     As Variant
Dim varErr                      As Variant
Dim varMatch                    As Variant
Dim varMsg                      As Variant
Dim wks                         As Excel.Worksheet
  strWS = "TestFinder"
  strMatchDate = "02/10/2016"
'*
'** Convert string date to internal
'** (numeric) value.
'*
  varDate = CDate(strMatchDate)
'*
'** Establish the range.
'*
  strRng = "B26:B208"
  Set wks = Worksheets(strWS)
  wks.Select
'*
'** Now find the numeric date value which
'** is at or greater than the target date.
'*
'*
'** The following code generates Error 2042.
'*
  With wks.Range(strRng)
    varMatch = Application.Match(varDate, _
                                 .Value, _
                                 -1)
  End With
'*
'** The following code generates Error 2015.
'*
varMatch = Application.Match(varDate, _
                               strRng, _
                               -1)
'*
'** The following code generates Error 1004.
'** "Unable to get the Vlookup property
'** of the Worksheetfunction class"
'** (i.e. exact match not found).
'*
  With Application.WorksheetFunction
    On Error Resume Next
    varMatch = .VLookup(varDate, _
                        strRng, _
                        1, _
                        True)
    varErr = Err.Number
    varMsg = Err.Description
    On Error GoTo 0
  End With
End Sub 'SampleCode

Any pointers would be greatly appreciated....

 

[steve the fish]

You could try replacing a couple of lines:

varDate = WorksheetFunction.EoMonth(CDate(strMatchDate), 0) + 1

varMatch = Application.Match(varDate, Range(strRng), 0)

varMatch should then have a numerical value should 01/11/2016 be in the range in question

 

[sts023]

"Haste is the enemy of accuracy"

I skim read the "Application.Match" description - OK, 0 is exact match, 1 is nearest under, -1 is nearest over. Right, let's get coding....

A little further on, we get the description of the match type, and for -1, the list must be in DESCENDING order.
Had I read that, it would have explained the error. My list is in ASCENDING order.

When recoded, I'll post the solution as a Function in case it can help anyone else.

Meanwhile, Steve the Fish - your solution of changing the search text to force a match is an admirable example of lateral thinking!