VBA Import text file to excel with desired result

[roykana]

Dear All Master,
I want to import from text file to excel and want the desired result as below and for column H I mark yellow then the result must be text.
I also attached a text file link
thanks
roykana

DESIRED RESULT

VBA IMPORT TEXT FILE.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R
1	No Transaction	Date	Dept.	Code Pel.	Name Customer	Address	No.	Cd. Item	Name Item	Qty	Unit	Price	Pot. %	Total	Pot. :	Tax :	Costs :	Total End :
2	0002/KSR/TK/1221	19-12-21		GENERAL	GENERAL		1	410288	TAMAKA R 410288 RC/L-TOP	1	PCS	115000	0	115000	40000	0	0	800000
3	0002/KSR/TK/1221	19-12-21		GENERAL	GENERAL		2	829740	TAMAKA R 829740 RC/L-TOP	2	PCS	90000	0	180000
4	0002/KSR/TK/1221	19-12-21		GENERAL	GENERAL		3	410240	TAMAKA R 410240 RC/L-TOP	1	PCS	125000	0	125000
5	0002/KSR/TK/1221	19-12-21		GENERAL	GENERAL		4	56117	ALFIN TRAVEL 56117 D1680 TG	1	PCS	105000	0	105000
6	0002/KSR/TK/1221	19-12-21		GENERAL	GENERAL		5	222445	TAMAKA R 222445 RC/L-TOP/USB	1	PCS	155000	0	155000
7	0002/KSR/TK/1221	19-12-21		GENERAL	GENERAL		6	111195	TAMAKA R 111195 RC/L-TOP/USB	1	PCS	160000	0	160000
8	0003/KSR/TK/1221	19-12-21		GENERAL	GENERAL		1	2019	ALFIN WB 2019 BATIK	1	PCS	35000	0	35000	0	0	0	35000
MASTER

Option Explicit

Sub Importtextfile()
    '// Declare a variable as
    Dim nRow            As Long
    Dim sExtension      As String
    Dim oFolder         As FileDialog '// FileDialog object
    Dim vSelectedItem   As Variant
    Dim wsSelect        As Worksheet
    '// Stop Screen Flickering
    Application.ScreenUpdating = False

    '// Create a FileDialog object as a File Picker dialog box
    Set oFolder = Application.FileDialog(msoFileDialogOpen)
    Set wsSelect = Sheets("MASTER")

    '// Use a With...End With block to reference FileDialog.
    With oFolder
        '// Allow multiple selection.
        .AllowMultiSelect = True
        '// Use the Show method to display the files.
        If .Show = -1 Then

    '// Extension
    sExtension = Dir("*.txt")

    '// Step through each SelectedItems
    For Each vSelectedItem In .SelectedItems

        '// Sets Row Number for Data to Begin
        nRow = Range("A1").End(xlUp).Offset(1, 0).Row
With wsSelect.Range("A1").CurrentRegion.Clear
End With
        '// Below is importing a text file
        With wsSelect.QueryTables.Add(Connection:= _
            "TEXT;" & sExtension, Destination:=Range("$A$" & nRow))
            .Name = sExtension
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 850
            .TextFileStartRow = 1
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = True
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = False
            .TextFileSpaceDelimiter = False
            .TextFileOtherDelimiter = ""
            .TextFileTrailingMinusNumbers = False
            .Refresh BackgroundQuery:=False
        End With
        sExtension = Dir
    Next
            '// If Cancel...
            Else
            End If
    End With

    Application.ScreenUpdating = True

    '// Set object to Nothing. Object? see Link Object
    Set oFolder = Nothing
End Sub

link text file

 

[NoSparks]

try changing

With wsSelect.Range("A1").CurrentRegion.Clear
End With

to

With wsSelect
    .Range("A1").CurrentRegion.Clear
    .Columns("H").Cells.NumberFormat = "@"
End With

 

[Marc L]

I want to import from text file to excel and want the desired result as below and for column H I mark yellow then the result must be text.

Just a bad import setting as it should be directly achieved within the QueryTables.Add block​

like any beginner can operate just activating the Macro Recorder and well answering to the Import Wizard Assistant​

in particular here for each column format …​

 

[roykana]

try changing

With wsSelect.Range("A1").CurrentRegion.Clear
End With

to

With wsSelect
    .Range("A1").CurrentRegion.Clear
    .Columns("H").Cells.NumberFormat = "@"
End With

@NoSparks
thanks for your reply. But here what I mean is import from textfile to excel so you can see the link of the sample text file. so my import results are still messy or not in accordance with the results I want like the results from excel that I posted in this post
Thanks
Roykana

 

[roykana]

Just a bad import setting as it should be directly achieved within the QueryTables.Add block​

like any beginner can operate just activating the Macro Recorder and well answering to the Import Wizard Assistant​

in particular here for each column format …​

@Marc L

thanks for your reply. But here what I mean is import from textfile to excel so you can see the link of the sample text file. so my import results are still messy or not in accordance with the results I want like the results from excel that I posted in this post. It's not like what you said if you find it easy please make an excel output like me from the text file that I share
Thanks
Roykana

 

[Marc L]

so you can see the link of the sample text file

Yes but, in order to waste time like in your previous thread, according to your linked text file​

I need your filled result macro workbook as well with a link like for your text file​

so I could choose to improve your way (so easy as any beginner can operate manually just well answering to the Import Wizard Assistant)​

or share a direct way (should look like pretty the same than in your previous thread).​

​

I hope also to have some revert in your previous thread before to go deeper here …​

 

[Marc L]

​

Correction of previous post : « in order to avoid to waste time … »​

 

[roykana]

​

Correction of previous post : « in order to avoid to waste time … »​

@Marc L
you mean my previous post and I've mark solution on your behalf

 

[Marc L]

You must paste this VBA demonstration to the MASTER worksheet module :​

Sub Demo1()
  Const N = "No. *"
    Dim V, F%, H, K, S, W, L&, T, R&, X
        ChDrive ThisWorkbook.Path:  ChDir ThisWorkbook.Path
    With Application
        V = .GetOpenFilename("Report files,*.txt", , "Select a file"):  If V = False Then Exit Sub
        F = FreeFile
        H = [{1,1;2,3;4,6;5,7}]
        K = [{7,1;8,2;9,3;10,8;11,9;12,10;13,11;14,12}]
        UsedRange.Offset(1).Clear
       .ScreenUpdating = False
       .ThousandsSeparator = "."
       .UseSystemSeparators = False
        Open V For Input As #F
        S = Split(Input(LOF(F), #F), vbCrLf)
        Close #F
        ReDim V(UBound(S), 1 To 18)
        W = .Match(N, S, 0)
    While IsNumeric(W)
        L = .Match("Pot. : *", S, 0) - 1
        T = .Trim(Split(S(L), vbTab))
        S(L) = "":  S(W - 1) = ""
        For L = 1 To 4:  V(R, L + 14) = T(2 + (L - 1) * 3):  Next
        T = .Trim(Split(S(W - 2), vbTab, 8))
    Do
        X = .Trim(Split(S(W), vbTab)):  If Not IsNumeric(X(1)) Then Exit Do
        For L = 1 To UBound(H):  V(R, H(L, 1)) = T(H(L, 2)):  Next
        For L = 1 To UBound(K):  V(R, K(L, 1)) = X(K(L, 2)):  Next
        R = R + 1
        W = W + 1
    Loop
        W = .Match(N, S, 0)
    Wend
    If R Then
        If .International(32) <> 1 Then
            For R = 0 To R - 1
                X = Split(V(R, 2), "/"):  If UBound(X) = 2 Then V(R, 2) = X(2) & "/" & X(1) & "/" & X(0)
            Next
        End If
        With [A2].Resize(R, UBound(V, 2))
            .Columns(8).NumberFormat = "@"
            .FormulaLocal = V
        End With
    End If
       .UseSystemSeparators = True
       .ScreenUpdating = True
    End With
End Sub

​

 

[Marc L]

you mean my previous post

Obviously not as it was relative to my post #6 and not to your previous thread (do not confuse post & thread …)​