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]

According to your post #5 attachment I would take the obvious easy path :​

Sub Demo0()
    With Sheet1.Range("E2:E" & Sheet1.UsedRange.Rows.Count)
        .Formula = "=VLOOKUP(C2,Table1,4,1)"
        .Formula = .Value
    End With
End Sub

​

But according to your post #9 where you need column E as text​

- this information was not in the initial post (as it must be !) where the picture is showing dates instead of texts ! Is is so difficult to just well explain your need ? -​

this is the revamped version :​

Sub Demo1()
        Dim V, R&
        Application.ScreenUpdating = False
    With Sheet1.Range("E2:E" & Sheet1.UsedRange.Rows.Count)
       .Formula = "=VLOOKUP(C2,Table1,4,1)"
        V = .Value
        For R = 1 To UBound(V):  V(R, 1) = CStr(V(R, 1)):  Next
       .NumberFormat = "@"
       .Value2 = V
    End With
        Application.ScreenUpdating = True
End Sub

@Marc L

thank you for your reply, if I do it with xlbb as below, then copy it to excel, then the format will be a date but the original format is general in column E and you can also see in the screenshot below which shows the format is general

vlookup dictionary approximate match.xlsm
	E
1	PERIOD
2	Jul-2017
3	Jul-2018
4	Jul-2019
5	Jul-2020
6	Jul-2021
SELECTFILE

 

[Marc L]

​

The reason why it's better in some case to link a workbook with a crystal clear & complete explanation in the first post …​

 

[roykana]

​

The reason why it's better in some case to link a workbook with a crystal clear & complete explanation in the first post …​

@Marc L

thanks for the information from you

 

[roykana]

@Marc L
can the format be general if it is text then the result is as below?

IMPORT FILE DAT DB ABSEN V.3.xlsm
	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	=IFERROR(VLOOKUP(C2,dbperiod,4,1),"")	NON STAFF	BAYU
3	5004	2017-07-27 07:43:31	27/07/2017	2017	=IFERROR(VLOOKUP(C2,dbperiod,4,1),"")	STAFF	AJENG KARTINI
4	5016	2017-07-27 07:45:23	27/07/2017	2017	=IFERROR(VLOOKUP(C2,dbperiod,4,1),"")	NON STAFF	RAHMAN
5	5020	2017-07-27 07:46:26	27/07/2017	2017	=IFERROR(VLOOKUP(C2,dbperiod,4,1),"")	NON STAFF	YOSEP
6	5008	2017-07-27 07:48:17	27/07/2017	2017	=IFERROR(VLOOKUP(C2,dbperiod,4,1),"")	STAFF	ADE SUPRIATNA
SELECTFILE

 

[shknbk2]

@shknbk2

thanks for your reply. I tried it was appropriate but the result should be text or general in column E in the "selectfile" sheet because the source is not a date format so I have to add code like below or do you have other recommendations

.Columns(5).NumberFormat = "@"

For my code, I would use your suggestion and put it right above the Value assignment for E2:

        .Columns(5).NumberFormat = "@"
        .Range("E2").Resize(UBound(Nary), 3).Value = Nary

In the download of your file, I notice that you had apostrophes in Col F of DB. Are those in the raw data of a normal spreadsheet or did you have to put them in the example data to make them text?

 

[roykana]

For my code, I would use your suggestion and put it right above the Value assignment for E2:

        .Columns(5).NumberFormat = "@"
        .Range("E2").Resize(UBound(Nary), 3).Value = Nary

In the download of your file, I notice that you had apostrophes in Col F of DB. Are those in the raw data of a normal spreadsheet or did you have to put them in the example data to make them text

@shknbk2


Yes, that's raw data from a normal spreadsheet

 

[roykana]

​

The reason why it's better in some case to link a workbook with a crystal clear & complete explanation in the first post …​

@Marc L
I have a recent post for you related to dat files

import data file to excel only for specific

Dear all master, so I want to import dat files to excel only for specific data or criteria that I want. So the data from the dat files is directly imported according to the criteria I want. The criteria I want are those starting from "2019-12-21". But I want the filter from the criteria to be...

www.mrexcel.com

 

[Marc L]

can the format be general if it is text then the result is as below?

When using a formula the cell format can't be text …​

 

[Marc L]

Precision about my previous post : when a VBA procedure allocates a formula to a cell the cell must not be formatted as text …​

 

[roykana]

​

Precision about my previous post : when a VBA procedure allocates a formula to a cell the cell must not be formatted as text …​

@Marc L

yes, you are right, so before the vba formula procedure, the column was already in clear format