Home » excel » Excel VBA: vlookup to find row of date in date range table

Excel VBA: vlookup to find row of date in date range table

Posted by: admin May 14, 2020 Leave a comment

Questions:

Hi and thanks in advance for any help. Extracting daily files that have the date in a cell. I need to use the date to find which week it falls into in a table which has start and end dates in two columns. There is more data in subsequent columns I need to extract once I know the row the date falls into. The cross reference table is in this format: The date variable (assigned to both string and date variables) that is picked up from the source needs to be compared to col’s A and B to find out what row it would fit in then extract fiscal year (Col A) as well as short description (col F)

Cross Ref Table
enter image description here

The adjusted and renamed destination file looks like this

enter image description here

How to&Answers:

This custom function is similar to Vlookup where it will compare the first two columns of a range as a date, and if the input date falls in the range, it will return the respective column.

Function rngLOOKUP(aDate As Date, rng As Range, theColumn As Long) As Variant
Dim acell As Range

For Each acell In rng.Columns(1).Cells
    If acell.Value <= aDate And acell.Offset(0, 1).Value >= aDate Then
        rngLOOKUP = acell.Offset(0, theColumn - 1).Value
        Exit Function
    End If
Next acell

rngLOOKUP = "#Nothing"

End Function

In this excel file, you can see it in action. Or see below screenshot. The highlight cell has the custom formula.

enter image description here

Answer:

The functionality described here can be accomplished via cell formulas without resorting a VBA function. I included 2 possible solutions.

I have simplified the scenario a bit. Assume that the cross reference table (located in Sheet1 of a XR.xlsx file) only contains these 3 columns:

          A               B               C
   +--------------+---------------+---------------+
 1 | PDWK_St_Date | PDWK_End_Date | Short_Descrip |
   +--------------+---------------+---------------+
 2 | 07-Nov-16    | 13-Nov-16     | P1W1          |
 3 | 14-Nov-16    | 20-Nov-16     | P1W2          |
 4 | 21-Nov-16    | 27-Nov-16     | P1W3          |
 5 | 28-Nov-16    | 04-Dec-16     | P1W4          |
 6 | 05-Dec-16    | 11-Dec-16     | P2W1          |
 7 | 12-Dec-16    | 18-Dec-16     | P2W2          |
 8 | 19-Dec-16    | 25-Dec-16     | P2W3          |
 9 | 26-Dec-16    | 01-Jan-17     | P2W4          |
10 | 02-Jan-17    | 08-Jan-17     | P3W1          |
11 | 09-Jan-17    | 15-Jan-17     | P3W2          |
12 | 16-Jan-17    | 22-Jan-17     | P3W3          |
13 | 23-Jan-17    | 29-Jan-17     | P3W4          |
14 | 30-Jan-17    | 05-Feb-17     | P4W1          |
15 | 06-Feb-17    | 12-Feb-17     | P4W2          |
16 | 13-Feb-17    | 19-Feb-17     | P4W3          |
17 | 20-Feb-17    | 26-Feb-17     | P4W4          |
18 | 27-Feb-17    | 05-Mar-17     | P5W1          |
   +--------------+---------------+---------------+

Solution 1 (simplified)

It only works if the date ranges are consecutive (i.e. start date = end date from previous row + 1 day) – his is the case in your cross reference table.

In your destination workbook, use VLOOKUP to refer to the cross reference table:

=VLOOKUP(B2,[XR.xlsx]Sheet1!$A$2:$C$18,3,TRUE)

The above formula is specific to row 2 in the destination table and assumes the “Business Date” is in column B (hence B2 in the 1st parameter), 2nd parameter is the lookup range, 3 in the 3rd parameter means the value to retrieve is in the 3rd column and TRUE allows date matching within a range (from start date to the next row’s start date).

Note that the formula can be easily replicated to other rows, e.g. by dragging the fill handle (the small square in the cell’s bottom-right corner).

Solution 2

In this approach, the business date is compared against both start and end dates from the cross-reference table. Instead of VLOOKUP, it uses INDEX and MATCH functions:

=INDEX([XR.xlsx]Sheet1!$C$2:$C$18,MATCH(1,(B2>=[XR.xlsx]Sheet1!$A$2:$A$18)*(B2<=[XR.xlsx]Sheet1!$B$2:$B$18),0),1)

Here, the business date (cell B2) is compared against both start and end date, the results are multiplied (equivalent to logical AND) and matched against 1 (i.e. TRUE).

IMPORTANT: After pasting this formula (e.g. into formula bar for cell C2) you need to hit Ctrl+Shift+Enter instead of the usual Enter. This is to indicate a so-called “array formula” (aka CSE formula); otherwise, our comparisons inside MATCH wouldn’t work as intended. You may refer to this post for more info. The CSE formulas show surrounded by braces in the formula bar. The good news is that they can be replicated just like all other formulas.

The destination table will look similar to:

      A           B              C       
   +------+---------------+-------------+
 1 | Unit | Business Date | Short Descr |
   +------+---------------+-------------+
 2 | 1102 | 26-Aug-17     | #N/A        |
 3 | 1102 | 05-Jan-17     | P3W1        |
 4 | 1102 | 06-Feb-17     | P4W2        |
 5 | 1102 | 11-Nov-16     | P1W1        |
 6 | 1102 | 02-Feb-17     | P4W1        |
 7 | 1102 | 01-Oct-16     | #N/A        |
   +------+---------------+-------------+

Note that in case of solution 1, cell C2 would contain P5W1 instead of #N/A – this is because no end date was used in comparison.

Answer:

The Function Provided by @PGTester worked great once a couple of issues were dealt with in the code:

1) Declarations: The declarations were all on one line for each type. This does not work in VBA as only the last variable is declared as intended and all previous ones are declared as variant. (ie, DIM adate, bdate, cdate as date) In this example only cdate is an actual date. Passing adate to the function resulted in a mismatch until the declarations were corrected. (This was pointed out by @Domenic)

2) Date formats: While all dates in the source file and the cross reference file were formatted as “yyyy-mmm-dd” prior to calling the function, Error 13, Type Mismatch still prevented the code from moving forward. Changing the format to “m-d-yyyy” on both the source file (done in code) and the cross reference table (manually prior to accessing) solved the issue and the following code worked as expected.

3) Pointing the function calls at the cross reference file for both the vlookup and rnglookup was done by building and setting variables to the pages needed. This simplified the selections when required.

Set variables for next steps
'
    Set CRef = Workbooks.Open(refFILE)
    Set shtJOB = CRef.Sheets("JobCross")
    Set shtDATE = CRef.Sheets("fcalendar")
    sht.Activate
    Set rngJOBS = Range("i2:i" & lastRow)
    Set rngJBGRP = shtJOB.Range("A1:b16")
    Set rng = shtDATE.Range("A2:f210")

Completed code with both functions follows:

Sub CleanDaily_Labour()
'
' CleanDaily_Labour Macro
' RMDC Payroll Resarch (MU) Report prep
'

' Note the separate declarations for each variable
'    
    Dim myPath As String, fName As String, refFILE As String, job As String, _
      JobGR As String, DateST As String, WKDay As String, PDWK As String
    Dim CRef As Workbook, wkb As Workbook
    Dim shtDATE As Worksheet, shtJOB As Worksheet, sht As Worksheet
    Dim aDate As Date, fYR As Date
    Dim fYear As Variant
    Dim rng As Range, rngJOBS As Range, rngJBGRP As Range
    Dim SC As Long, lastRow As Long, PD As Long, WK As Long

    ' Application.ScreenUpdating = False
    myPath = Application.ActiveWorkbook.Path
'
' Get the file date and assign to variables
'
    Range("D3").Select
    **Selection.NumberFormat = "m-d-yyyy"**
    aDate = Range("D3").Value
    DateST = WorksheetFunction.Text(aDate, "YYYYMMDD")
    WKDay = WorksheetFunction.Text(aDate, "DDD")

    Selection.Copy
    Range("D7").Select
    ActiveSheet.Paste
'
' Rename and save the active workbook by date
' set wkb to new workbook name and assign calendar cross ref
'
    fName = myPath & "\Daily_Labour_" _
        & DateST & ".xlsx"
    ActiveWorkbook.SaveAs fName, 51
    Set wkb = Workbooks.Open(fName)
    Set sht = wkb.Sheets("Sheet1")


    refFILE = myPath & "\Cross_Ref_fCalendar.xlsx"

'
' Remove extra header info
'
    Rows("1:5").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
'
'   Insert Column to the left of Column D
'
    Columns("E:G").Insert Shift:=xlToRight, _
      CopyOrigin:=xlFormatFromRightOrBelow
'
' Update Headers that will be kept / used
'
    Range("A1").Value = "FYear"
    Range("E1").Value = "PD_WK"
    Range("J1").Value = "JOB_GRP"
    Range("F1").Value = "WKDay"
    Range("G1").Value = "PD"
    Range("H1").Value = "WK"
'
    Rows("1:1").Select
    With Selection
        .HorizontalAlignment = xlCenter
    End With
'
' Remove extra columns
'
    Sheets("Sheet1").Range("K:K,M:P,R:AY").EntireColumn.Delete
'
' Get the last row and fill known columns
'
    lastRow = Cells(Rows.Count, 1).End(xlUp).row
    Range("d2:d" & lastRow).Value = aDate
    Range("d2:d" & lastRow).NumberFormat = "m-d-yyyy"
    Range("f2:f" & lastRow).Value = WKDay
'
' Set variables for next steps
'
    Set CRef = Workbooks.Open(refFILE)
    Set shtJOB = CRef.Sheets("JobCross")
    Set shtDATE = CRef.Sheets("fcalendar")
    sht.Activate
    Set rngJOBS = Range("i2:i" & lastRow)
    Set rngJBGRP = shtJOB.Range("A1:b16")
    Set rng = shtDATE.Range("A2:f210")
'
' Loop through jobs in column i match job in shtJOB
' put matching group in row j (Use Function vLookupVBA)
'
    For Each jRow In rngJOBS
        jRow.Select
        job = ActiveCell.Value
        JobGR = VLookupVBA(job, rngJBGRP, Null)
        ActiveCell.Offset(0, 1).Value = JobGR
    'end for
   Next jRow
'
'Save Progress during testing:
'
   Application.DisplayAlerts = False
   ActiveWorkbook.SaveAs fName, 51
'
' Fill in date parameters from Cross Ref file for Business date
' Use function rngLOOKUP to update variables then set ranges to the variables
' May be more efficient to get row number from cross ref table instead - later.
'
    shtDATE.Activate '(does not seem to affect)
'
    fYear = rngLOOKUP(aDate, rng, 3)
    PDWK = rngLOOKUP(aDate, rng, 6)
    PD = rngLOOKUP(aDate, rng, 4)
    WK = rngLOOKUP(aDate, rng, 5)
'
' Fill the columns with the variables (can likely bypass the variables and put on 1 line)- later
'
    sht.Activate
    Range("A2:A" & lastRow).Value = fYear
    Range("E2:E" & lastRow).Value = PDWK
    Range("G2:G" & lastRow).Value = PD
    Range("H2:H" & lastRow).Value = WK
'
' Close reference file
'
    Application.DisplayAlerts = False
    CRef.Close False
'
' Cleanup, save and close workbooks
'
    Application.DisplayAlerts = False
    wkb.SaveAs fName, 51
'
' SQL call: Load to existing datbase (GDrive), use same format as Transactions
' ?? Get sales by day? vs maintain PDWK - Future
'
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
'    wkb.Close.false



End Sub
Private Function VLookupVBA(what As Variant, lookupRng As Range, defaultValue As Variant) As Variant
    Dim rv As Variant: rv = Application.VLookup(what, lookupRng, lookupRng.Columns.Count, False)
    If IsError(rv) Then
        VLookupVBA = "NULL"
    Else
        VLookupVBA = rv
    End If
End Function

Public Sub UsageExample()
    MsgBox VLookupVBA("ValueToFind", ThisWorkbook.Sheets("ReferenceSheet").Range("A:D"), "Not found!")
End Sub
Function rngLOOKUP(chkDate As Date, rngf As Range, theColumn As Long) As Variant
Dim acell As Range

'
For Each acell In rngf.Columns(1).Cells
    If acell.Value <= chkDate And acell.Offset(0, 1).Value >= chkDate Then
        rngLOOKUP = acell.Offset(0, theColumn - 1).Value
        Exit Function
    End If
Next acell

rngLOOKUP = "#Nothing"

End Function