Return a Value if Date is within Date Range and ID Matches - Formula or VBA appreciated

Not_Excel_lent

New Member
Joined
Oct 2, 2016
Messages
8
Hello and thanks for the help in advance. I have been googling and trying to overcome this issue for days and cannot seem to get Index, Match or Lookup formula's to work. I have the following 2 Worksheets in a single Workbook (raw file gets converted and VBA code copies the second sheet in - probably irrelevant but thought I should mention).

The below is a table is a worksheet called 'Device List' with all Devices, UID's (unique Identifiers), Deployment Periods and Specific Deployment Locations.
[TABLE="class: grid, width: 500, align: left"]
<tbody>[TR]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[TD]F[/TD]
[TD]G[/TD]
[TD]H[/TD]
[/TR]
[TR]
[TD]Device[/TD]
[TD]UID[/TD]
[TD]Deploy[/TD]
[TD]Retreive[/TD]
[TD]Site[/TD]
[TD]Grid[/TD]
[TD]Alt[/TD]
[TD]Var[/TD]
[/TR]
[TR]
[TD]X R1[/TD]
[TD]1AA[/TD]
[TD]17/04/2018[/TD]
[TD]17/04/2018[/TD]
[TD]Bris1[/TD]
[TD]77R[/TD]
[TD]B1[/TD]
[TD]N[/TD]
[/TR]
[TR]
[TD]X R1[/TD]
[TD]1AA[/TD]
[TD]18/04/2018[/TD]
[TD]25/06/2018[/TD]
[TD]Testing[/TD]
[TD]Nil[/TD]
[TD]Nil[/TD]
[TD]Nil[/TD]
[/TR]
[TR]
[TD]X R1[/TD]
[TD]1AA[/TD]
[TD]26/06/2018[/TD]
[TD]01/01/2019[/TD]
[TD]Bris2[/TD]
[TD]84P[/TD]
[TD]B2[/TD]
[TD]N[/TD]
[/TR]
[TR]
[TD]X R1[/TD]
[TD]1AB[/TD]
[TD]17/04/2018[/TD]
[TD]01/01/2019[/TD]
[TD]Bris1[/TD]
[TD]77R[/TD]
[TD]B1[/TD]
[TD]N[/TD]
[/TR]
</tbody>[/TABLE]


[TABLE="width: 597"]
<tbody>[TR]
[TD]
The following has reading information including Date, Time, Device, Type of reading and the Value. It needs the Location information.

[TABLE="class: grid, width: 500, align: left"]
<tbody>[TR]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[TD]F[/TD]
[TD]G[/TD]
[TD]H[/TD]
[TD]I[/TD]
[/TR]
[TR]
[TD]Date[/TD]
[TD]Time[/TD]
[TD]Device[/TD]
[TD]Site[/TD]
[TD]Grid[/TD]
[TD]Alt[/TD]
[TD]Var[/TD]
[TD]Type[/TD]
[TD]Value[/TD]
[/TR]
[TR]
[TD]18/05/2018[/TD]
[TD]12:06:43 PM[/TD]
[TD]1AA[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]CO[/TD]
[TD]0[/TD]
[/TR]
[TR]
[TD]18/05/2018[/TD]
[TD]12:06:43 PM[/TD]
[TD]1AA[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]CO2[/TD]
[TD]34.56[/TD]
[/TR]
[TR]
[TD]18/07/2018[/TD]
[TD]12:06:43 PM[/TD]
[TD]1AB[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]CO[/TD]
[TD]15.59[/TD]
[/TR]
[TR]
[TD]18/07/2018[/TD]
[TD]12:06:43 PM[/TD]
[TD]1AB[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Co2[/TD]
[TD]194[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
</tbody>[/TABLE]

This is a snapshot of the data set however I am trying to get D,E,F,G above to fill with for Device 1AA on 18/05/2018 'Testing', 'Nil', "Nil', 'Nil' and 1AB on 18/07/2018 to be 'Bris1', '77R', 'B1', 'N'.

The issue I seem to be hitting is I cannot work out to have the Date in A find its home between the Dates in C & D then ensure the Device in C matches the UID in B with the final result in D to always be whatever matches in E.

Whatever solution works will be converted into a Macro which will run across the files hourly to ensure no humans are required for the data conversion process from raw file to polished file ready for upload into my analytics tool. The solution seems so simple but I am stuffed if I can get it to work right every time.

Appreciate the help and if you need more info or more data let me know.

Cheers!:eeek:
 

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.
Try this For Basic Data in sheet1 and your results table in sheet2.
Code:
[COLOR="Navy"]Sub[/COLOR] MG29Jul15
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Q [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]With[/COLOR] Sheets("Sheet1")
    [COLOR="Navy"]Set[/COLOR] Rng = .Range("B2", .Range("B" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] Not .exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
        ReDim ray(1 To Rng.Count, 1 To 3)
        ray(1, 1) = CDbl(DateValue(Dn.Offset(, 1)))
        ray(1, 2) = CDbl(DateValue(Dn.Offset(, 2)))
        ray(1, 3) = Join(Application.Index(Dn.Offset(, 3).Resize(, 4).Value, 0, 0), ",")
        .Add Dn.Value, Array(ray, 1)
     [COLOR="Navy"]Else[/COLOR]
        Q = .Item(Dn.Value)
            Q(1) = Q(1) + 1
            Q(0)(Q(1), 1) = CDbl(DateValue(Dn.Offset(, 1)))
            Q(0)(Q(1), 2) = CDbl(DateValue(Dn.Offset(, 2)))
            Q(0)(Q(1), 3) = Join(Application.Index(Dn.Offset(, 3).Resize(, 4).Value, 0, 0), ",")
        .Item(Dn.Value) = Q
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]With[/COLOR] Sheets("Sheet2")
    [COLOR="Navy"]Set[/COLOR] Rng = .Range("C2", .Range("C" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
[COLOR="Navy"]If[/COLOR] .exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
    [COLOR="Navy"]For[/COLOR] n = 1 To .Item(Dn.Value)(1)
        [COLOR="Navy"]If[/COLOR] CDbl(DateValue(Dn.Offset(, -2))) >= .Item(Dn.Value)(0)(n, 1) And CDbl(DateValue(Dn.Offset(, -2))) <= .Item(Dn.Value)(0)(n, 2) [COLOR="Navy"]Then[/COLOR]
            Dn.Offset(, 1).Resize(, 4) = Split(.Item(Dn.Value)(0)(n, 3), ",")
        [COLOR="Navy"]End[/COLOR] If
 [COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
I am needing some help to push this out to where the first table where I am extracting the data now has a column I which needs to come across to the other table into column H (where H & I are pushed out to I & J)

I will continue to fiddle with the macro but thought it may be more effective to ask the brains trust.
 
Upvote 0
fixed, apologies for the post - maybe this will help someone else in the future.

Code:
Dim Rng As Range, Dn As Range, n As Long, Q As VariantWith Sheets("Device List")
    Set Rng = .Range("B2", .Range("B" & Rows.Count).End(xlUp))
End With
With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
For Each Dn In Rng
    If Not .exists(Dn.Value) Then
        ReDim ray(1 To Rng.Count, 1 To 3)
        ray(1, 1) = CDbl(DateValue(Dn.Offset(, 1)))
        ray(1, 2) = CDbl(DateValue(Dn.Offset(, 2)))
        ray(1, 3) = Join(Application.Index(Dn.Offset(, 3).Resize(, 5).Value, 0, 0), ",")
        .Add Dn.Value, Array(ray, 1)
     Else
        Q = .Item(Dn.Value)
            Q(1) = Q(1) + 1
            Q(0)(Q(1), 1) = CDbl(DateValue(Dn.Offset(, 1)))
            Q(0)(Q(1), 2) = CDbl(DateValue(Dn.Offset(, 2)))
            Q(0)(Q(1), 3) = Join(Application.Index(Dn.Offset(, 3).Resize(, 5).Value, 0, 0), ",")
        .Item(Dn.Value) = Q
    End If
Next
With Sheets("Data For Working")
    Set Rng = .Range("C2", .Range("C" & Rows.Count).End(xlUp))
End With
For Each Dn In Rng
If .exists(Dn.Value) Then
    For n = 1 To .Item(Dn.Value)(1)
        If CDbl(DateValue(Dn.Offset(, -2))) >= .Item(Dn.Value)(0)(n, 1) And CDbl(DateValue(Dn.Offset(, -2))) <= .Item(Dn.Value)(0)(n, 2) Then
            Dn.Offset(, 1).Resize(, 5) = Split(.Item(Dn.Value)(0)(n, 3), ",")
        End If
 Next n
End If
Next Dn
End With
 
Last edited:
Upvote 0

Forum statistics

Threads
1,223,236
Messages
6,170,906
Members
452,366
Latest member
TePunaBloke

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top