vlookup dictionary approximate match

[roykana]

Dear all Master,
below I want the desired result in column E which I marked in yellow and also I use a formula so it's easy to understand what I mean and I want to add a little in the code below without changing the structure of the code below and I also made a vba code for in column E in sheet "selectfile" with marking red but it doesn't work because I'm also wrong in the code

Sub vloookupdictionary()
Dim Rng As Range, Ds As Range, n As Long, Dic As Object, Source As Variant
Dim Ary As Variant
Dim startTime As Double
Dim endTime As Double
Dim t
t = Timer
endTime = Timer
'Dim startTime As Double
'Dim endTime As Double
Application.ScreenUpdating = False
[COLOR=rgb(209, 72, 65)]With Sheets("DB")
    Source = .Range("C1").CurrentRegion.Resize(, 4)
End With
Set Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbBinaryCompare
For n = 2 To UBound(Source, 1)
    Dic(Source(n, 1)) = n
Next

[COLOR=rgb(209, 72, 65)]'result in column E Sheet "selectfile"
With Sheets("SELECTFILE")
    Ary = .Range("C2", .Range("C" & Rows.Count).End(xlUp)).Value2
    ReDim Nary(1 To UBound(Ary), 1 To 3)
    For n = 1 To UBound(Ary)
        If Dic.Exists(Ary(n, 1)) Then
            Nary(n, 1) = Source(Dic(Ary(n, 1)), 4)
        End If
    Next n
    .Range("E2").Resize(UBound(Nary), 1).Value = Nary
End With
With Sheets("DB")
    Source = .Range("i1").CurrentRegion.Resize(, 4)
End With[/COLOR]
Set Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
For n = 2 To UBound(Source, 1)
    Dic(Source(n, 1)) = n
Next[/COLOR]
With Sheets("SELECTFILE")
    Ary = .Range("A2", .Range("A" & Rows.Count).End(xlUp)).Value2
    ReDim Nary(1 To UBound(Ary), 1 To 3)
    For n = 1 To UBound(Ary)
        If Dic.Exists(Ary(n, 1)) Then
            Nary(n, 1) = Source(Dic(Ary(n, 1)), 3)
            Nary(n, 2) = Source(Dic(Ary(n, 1)), 2)
        End If
    Next n
    .Range("F2").Resize(UBound(Nary), 2).Value = Nary
End With


Application.ScreenUpdating = True

'Debug.Print "Demo-03????:" & amp; amp; endTime - startTime
Debug.Print "It's done in: " & Timer - t & " seconds"
Debug.Print "Time to complete = " & Timer - startTime & " seconds."
End Sub

desired result

Book3
	A	B	C	D	E	F	G
1	ID	DATE & TIME	DATE	YEAR	PERIOD	CATEGORY	NAME
2	5014	2017-07-27 07:42:23	27/07/2017	2017	Jul-2017	NON STAFF	OTHERS01
3	5004	2018-07-27 07:43:31	27/07/2018	2018	Jul-2018	MANAGER	OTHERS02
4	5016	2017-07-27 07:45:23	27/07/2019	2019	Jul-2019	NON STAFF	OTHERS03
5	5020	2017-07-27 07:46:26	27/07/2020	2020	Jul-2020	NON STAFF	OTHERS04
6	5008	2017-07-27 07:48:17	27/07/2021	2021	Jul-2021	NON STAFF	OTHERS04
SELECTFILE

Cell Formulas
Range	Formula
E2:E6	E2	=VLOOKUP(C2,Table1,4,1)

source table

vlookup dictionary approximate match.xlsm
	C	D	E	F	G	H	I	J	K	L
1	DATE1	DATE2	PERIOD1	PERIOD2			ID	NAME	CATEGORY	LOCATION
2	21/07/2017	20/07/2017	01 Juli-2017	Jul-2017			5014	OTHERS01	NON STAFF	SHOP01
3	27/07/2018	20/07/2018	01 Juli-2018	Jul-2018			5004	OTHERS02	MANAGER	SHOP02
4	27/07/2019	20/07/2019	01 Juli-2019	Jul-2019			5016	OTHERS03	NON STAFF	SHOP03
5	27/07/2020	20/07/2020	01 Juli-2020	Jul-2020			5020	OTHERS04	NON STAFF	SHOP04
6	27/07/2021	20/07/2021	01 Juli-2021	Jul-2021			5008	OTHERS04	NON STAFF	SHOP05
DB

Thanks
roykana

 

[roykana]

@Marc L
I have a previous post in the link below maybe you can help me

vba event handler in array

Dear All master, I want if I make changes in the "master" sheet it automatically changes in the "trans" sheet. I want a fast code because there are thousands of records in the "trans" sheet. ABCDEFGHIJ1Supplier NameCODENEW CODECOMBINEITEM DESCNEW PRICEIsiUNIT IN ACTUALPriceUNIT IN...

www.mrexcel.com