import data file to excel only for specific

[roykana]

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 done directly in the dat file, not in excel.
Please comment on the code so that I can change the criteria in the future.


desired result

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	5020	2020-07-27 07:46:26	27/07/2020	2020
3	5008	2021-07-27 07:48:17	27/07/2021	2021
4	5023	2019-12-21 07:13:14	21/12/2019	2019
5	5029	2020-07-28 07:13:23	28/07/2020	2020
6	5026	2021-07-28 07:16:46	28/07/2021	2021
7	1006	2020-05-06 17:48:15	06/05/2020	2020
8	2009	2021-05-06 17:48:21	06/05/2021	2021
SELECTFILE

sample file dat


This code was previously generated on behalf of the user @Marc L

Option Explicit
Sub Get_Data_From_File()
Dim V, W, F%, R&, X, S, L&, Y
Dim Rng As Range, Ds As Range, n As Long, Dic As Object, Source As Variant
Dim i As Long
Dim Ary As Variant
Dim startTime As Double
    startTime = Timer
        V = ThisWorkbook.Path & "\test dat file update\":  If Dir(V & "*.dat") > "" Then ChDrive V: ChDir V
        W = Application.GetOpenFilename("Text files,*.dat", , "Select files(s)", , True):  If Not IsArray(W) Then Exit Sub
        F = FreeFile
        R = 2
    With Sheets("selectfile")
'       .UsedRange.Clear
        .Columns("A:G").Clear
        Application.ScreenUpdating = False
        ReDim V(.Rows.Count - 2, 1 To 4)
'   Pre-format column B for text
    .Columns("B:B").NumberFormat = "@"
    .Columns("C:C").NumberFormat = "DD/MM/YYYY"

    For Each X In W
        Open X For Input As #F
        S = Split(Input(LOF(F), #F), vbCrLf)
        Close #F
    For L = 0 To UBound(S) + (S(UBound(S)) = "")
        Y = Split(S(L), vbTab)
    If IsDate(Y(1)) Then
        V(L, 4) = Split(Y(1), "-", 2)(0)
    Else
        Y(1) = Replace(Replace(Y(1), "--", "/"), "-", "")
        V(L, 4) = Split(Y(1), "/", 2)(0)
    End If
        V(L, 1) = Y(0)
        V(L, 2) = Y(1)
        V(L, 3) = Split(Y(1))(0)
    Next
       .Cells(R, 1).Resize(L, UBound(V, 2)).Value = V
        R = R + L
    Next
       .[A1:G1] = [{"ID","DATE & TIME","DATE","YEAR","PERIOD","CATEGORY","NAME"}]
       .ListObjects.Add 1, .[A1].CurrentRegion, , 1
    End With
        Application.ScreenUpdating = True
            Debug.Print "Time to complete = " & Timer - startTime & " seconds."
End Sub

 

[Marc L]

Hi, according to your attachment my original VBA demonstration revamped :​

Sub Demo1d()
    Dim V, W, F%, R&, X, S, N&, L&, Y
        V = ThisWorkbook.Path & "\test dat file - new\":  If Dir(V & "*.dat") > "" Then ChDrive V: ChDir V
        W = Application.GetOpenFilename("Text files,*.dat", , "Select files(s)", , True):  If Not IsArray(W) Then Exit Sub
        F = FreeFile
        R = 2
    With Sheets("selectfile")
       .UsedRange.Clear
        Application.ScreenUpdating = False
        ReDim V(.Rows.Count - 2, 1 To 4)
    For Each X In W
        Open X For Input As #F
        S = Split(Input(LOF(F), #F), vbCrLf)
        Close #F
        N = 0
    For L = 0 To UBound(S) + (S(UBound(S)) = "")
        Y = Split(S(L), vbTab)
    If IsDate(Y(1)) Then
        V(N, 4) = Split(Y(1), "-", 2)(0)
    Else
        Y(1) = Replace(Replace(Y(1), "--", "/"), "-", "")
        V(N, 4) = Split(Y(1), "/", 2)(0)
    End If
        If DateValue(Y(1)) >= #12/21/2019# Then
            V(N, 1) = Y(0)
            V(N, 2) = Y(1)
            V(N, 3) = Split(Y(1))(0)
            N = N + 1
        End If
    Next
        If N Then .Cells(R, 1).Resize(N, UBound(V, 2)).Value = V: R = R + N
    Next
       .[A1:G1] = [{"ID","DATE & TIME","DATE","YEAR","PERIOD","CATEGORY","NAME"}]
       .ListObjects.Add 1, .UsedRange, , 1
    End With
        Application.ScreenUpdating = True
End Sub

 

[roykana]

Hi, according to your attachment my original VBA demonstration revamped :​

Sub Demo1d()
    Dim V, W, F%, R&, X, S, N&, L&, Y
        V = ThisWorkbook.Path & "\test dat file - new\":  If Dir(V & "*.dat") > "" Then ChDrive V: ChDir V
        W = Application.GetOpenFilename("Text files,*.dat", , "Select files(s)", , True):  If Not IsArray(W) Then Exit Sub
        F = FreeFile
        R = 2
    With Sheets("selectfile")
       .UsedRange.Clear
        Application.ScreenUpdating = False
        ReDim V(.Rows.Count - 2, 1 To 4)
    For Each X In W
        Open X For Input As #F
        S = Split(Input(LOF(F), #F), vbCrLf)
        Close #F
        N = 0
    For L = 0 To UBound(S) + (S(UBound(S)) = "")
        Y = Split(S(L), vbTab)
    If IsDate(Y(1)) Then
        V(N, 4) = Split(Y(1), "-", 2)(0)
    Else
        Y(1) = Replace(Replace(Y(1), "--", "/"), "-", "")
        V(N, 4) = Split(Y(1), "/", 2)(0)
    End If
        If DateValue(Y(1)) >= #12/21/2019# Then
            V(N, 1) = Y(0)
            V(N, 2) = Y(1)
            V(N, 3) = Split(Y(1))(0)
            N = N + 1
        End If
    Next
        If N Then .Cells(R, 1).Resize(N, UBound(V, 2)).Value = V: R = R + N
    Next
       .[A1:G1] = [{"ID","DATE & TIME","DATE","YEAR","PERIOD","CATEGORY","NAME"}]
       .ListObjects.Add 1, .UsedRange, , 1
    End With
        Application.ScreenUpdating = True
End Sub

@Marc L

thank you for your reply and it went perfectly and you are the best
thanks
roykana

 

[roykana]

@Marc L
Sorry I forgot to mark the solution of your code answer
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