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

[Not_Excel_lent]

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.

A	B	C	D	E	F	G	H
Device	UID	Deploy	Retreive	Site	Grid	Alt	Var
X R1	1AA	17/04/2018	17/04/2018	Bris1	77R	B1	N
X R1	1AA	18/04/2018	25/06/2018	Testing	Nil	Nil	Nil
X R1	1AA	26/06/2018	01/01/2019	Bris2	84P	B2	N
X R1	1AB	17/04/2018	01/01/2019	Bris1	77R	B1	N

<tbody>
</tbody>

The following has reading information including Date, Time, Device, Type of reading and the Value. It needs the Location information. A B C D E F G H I Date Time Device Site Grid Alt Var Type Value 18/05/2018 12:06:43 PM 1AA CO 0 18/05/2018 12:06:43 PM 1AA CO2 34.56 18/07/2018 12:06:43 PM 1AB CO 15.59 18/07/2018 12:06:43 PM 1AB Co2 194 <tbody> </tbody>

<tbody>
</tbody>

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!

 

[MickG]

Try this For Basic Data in sheet1 and your results table in sheet2.

[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

 

[Not_Excel_lent]

Thank you @MickG that works perfectly. There was no way I every would have achieved that on my own, truly appreciate the assistance.

 

[MickG]

You're welcome

 

[Not_Excel_lent]

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.

 

[Not_Excel_lent]

fixed, apologies for the post - maybe this will help someone else in the future.

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