import data file to excel only for specific

roykana

Active Member
Joined
Mar 8, 2018
Messages
309
Office Version
  1. 2010
Platform
  1. Windows
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
ABCDEFG
1IDDATE & TIMEDATEYEARPERIODCATEGORYNAME
250202020-07-27 07:46:2627/07/20202020
350082021-07-27 07:48:1727/07/20212021
450232019-12-21 07:13:1421/12/20192019
550292020-07-28 07:13:2328/07/20202020
650262021-07-28 07:16:4628/07/20212021
710062020-05-06 17:48:1506/05/20202020
820092021-05-06 17:48:2106/05/20212021
SELECTFILE


sample file dat


This code was previously generated on behalf of the user @Marc L
VBA Code:
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
 

Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.

Marc L

Banned User
Joined
Apr 5, 2021
Messages
2,030
Office Version
  1. 2010
Platform
  1. Windows
Hi, according to your attachment my original VBA demonstration revamped :​
VBA Code:
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
 
Solution

roykana

Active Member
Joined
Mar 8, 2018
Messages
309
Office Version
  1. 2010
Platform
  1. Windows
Hi, according to your attachment my original VBA demonstration revamped :​
VBA Code:
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

Active Member
Joined
Mar 8, 2018
Messages
309
Office Version
  1. 2010
Platform
  1. Windows
@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
 

Forum statistics

Threads
1,175,456
Messages
5,897,525
Members
434,659
Latest member
Fityi

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
Top