• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Automatic extraction of column data from text and paste it to excel

Dil09

New Member
Hi everyone,
I have several of text files having the same pattern and header. I need to extract just one column from text file and paste it to excel. What now I am doing I open the text file in a workbook, separate the columns,copy the specific column and past it to the another excel sheet. What I need to do:
1. Open text file
2. copy one column from the text file
3. paste to excel sheet
4. automate this steps for a folder of text files

I am really new in excel VBA coding and could not find a way to do this. Please help me.
 

Attachments

AlanSidman

Well-Known Member
When you paste the column from each txt file, are you appending each column so that you have one long column? Which column of the two are you copying and pasting? Need a better explanation. What version of Excel are you using. This will determine how we solve this.
 

Marc L

Excel Ninja
Please help me.
Hi,​
without any initial post explanation at the level of what any Excel forum expects for,​
you can activate the Macro Recorder and operate manually in order to get a VBA code for starters …​
 

Dil09

New Member
Hi,
Thanks everyone for reply. I want to extract only second column and put it to excel sheet column "A". Then from the another text file extract again the second column and put it to excel column "B" and so on. I am not appending them just writing in one column after another. The problem is I have 1000+ of files and I cannot do it manually. I have added two text file and one how I desire them in excel sheet.
 

Attachments

Marc L

Excel Ninja
Why rows 1 to 3 are empty in the result ?​
Do you prefer a Power Query (Get & Transform) solution or a VBA procedure ?​
 

Dil09

New Member
Hi,
I kept them empty to write something for later on. I want a VBA procedure to automate this process.
 

Marc L

Excel Ninja
According to your attachment a VBA demonstration to paste to the Sheet1 worksheet module & workbook saved into the folder of text files :​
Code:
Sub Demo1()
    Dim N%, P$, F$, V, C%, R&
        UsedRange.Clear
        Application.ScreenUpdating = False
        N = FreeFile
        P = ThisWorkbook.Path & "\"
        F = Dir$(P & "*.txt")
  While F > ""
        Open P & F For Input As #N
        V = Application.Trim(Split(Input(LOF(N), #N), vbCrLf))
        Close #N
    If UBound(V) > 1 Then
         V(2) = Empty
            C = C + 1
        For R = 4 To UBound(V)
            If InStr(V(R), " ") Then V(R) = Split(V(R))(1)
        Next
            Cells(C).Resize(UBound(V)).Value2 = Application.Transpose(V)
    End If
        F = Dir$
  Wend
        Application.ScreenUpdating = True
End Sub
Do you like it ? So thanks to click on bottom right Like !​
 

Dil09

New Member
Hi, It's awesome. You are great. Thank you very much. Now I am trying to run your code for a bunch of subfolders having the same type of texts.
 

Dil09

New Member
Hi, Can you also help me a little on looping through the files in folders? What I have is a folder Named "New Folder" and inside of it some subfolders where the texts are stored. I googled and got a code to loop through the subfolders. But because of my very little knowledge on VBA coding I could not organize it. Would you be kind to look at the code. I put your code with little change in the location 'Insert the actions to be performed on each file'. But it gives me error. Or you can refer me to do other thing which will help me to loop through the folders of files.

Code:
Sub loopAllSubFolderSelectStartDirectory()

'Another Macro must call LoopAllSubFolders Macro to start to procedure
Call LoopAllSubFolders("C:\temp\New folder\")

End Sub

'List all files in sub folders
Sub LoopAllSubFolders(ByVal folderPath As String)

Dim fileName As String
Dim fullFilePath As String
Dim numFolders As Long
Dim folders() As String
Dim i As Long
Dim N%, V, C%, R&
N = FreeFile
If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
fileName = Dir(folderPath & "*.*", vbDirectory)

While Len(fileName) <> 0

    If Left(fileName, 1) <> "." Then

        fullFilePath = folderPath & fileName

        If (GetAttr(fullFilePath) And vbDirectory) = vbDirectory Then
            ReDim Preserve folders(0 To numFolders) As String
            folders(numFolders) = fullFilePath
            numFolders = numFolders + 1
        Else
            'Insert the actions to be performed on each file
           
            Open fullFilePath For Input As #N
        V = Application.Trim(Split(Input(LOF(N), #N), vbCrLf))
        Close #N
    If UBound(V) > 1 Then
         V(2) = Empty
            C = C + 1
        For R = 4 To UBound(V)
            If InStr(V(R), " ") Then V(R) = Split(V(R))(1)
        Next
            Cells(C).Resize(UBound(V)).Value2 = Application.Transpose(V)
           
     
            'This example will print the full file path to the immediate window
            Debug.Print folderPath & fileName
        End If

    End If

    fileName = Dir()

Wend

For i = 0 To numFolders - 1

    LoopAllSubFolders folders(i)

Next i

End Sub
 

Marc L

Excel Ninja
Such important informations must be in the initial post !​
From the thread Scanning a folder and sub folders, FSO ? Dir ‼ a sub folders demonstration to paste to the top of the worksheet module :​
Code:
Dim C%

Function DirList(SCAN$, Optional FOLD$, Optional ATTR As VbFileAttribute = vbNormal) As String()
         Dim B%, D$, F$, T$(), U&
    With Application
        If FOLD > "" Then
            If Right(FOLD, 1) <> .PathSeparator And Left(SCAN, 1) <> .PathSeparator Then FOLD = FOLD & .PathSeparator
            D = FOLD
        Else
            D = Left$(SCAN, InStrRev(SCAN, .PathSeparator))
        End If
    End With
        If SCAN = "." Then SCAN = "*."
        On Error Resume Next
        F = Dir$(FOLD & SCAN, ATTR)
    Do Until F = ""
        If ATTR And vbDirectory Then B = Right(F, 1) = "." Or (GetAttr(D & F) And vbDirectory) = 0
        If B = 0 Then U = U + 1: ReDim Preserve T(1 To U): T(U) = FOLD & F
        F = Dir$
    Loop
         DirList = IIf(U, T, Split(""))
End Function

Sub DirScan(WHAT$, ByVal FROM$)
    Dim N%, V, R&
        N = FreeFile
    For Each V In DirList(WHAT, FROM)
            Open V For Input As #N
            V = Application.Trim(Split(Input(LOF(N), #N), vbCrLf))
            Close #N
        If UBound(V) > 1 Then
             V(2) = Empty
                C = C + 1
            For R = 4 To UBound(V)
                If InStr(V(R), " ") Then V(R) = Split(V(R))(1)
            Next
                Cells(C).Resize(UBound(V)).Value2 = Application.Transpose(V)
        End If
    Next
        For Each V In DirList("*", FROM, vbDirectory):  DirScan WHAT, V:  Next
End Sub

Sub Demo2()
    UsedRange.Clear
    [B2].Value2 = "Scanning …"
    Application.ScreenUpdating = False
    C = 0
    DirScan "*.txt", "C:\Temp\New folder\"
    Application.ScreenUpdating = True
End Sub
You should Like it !​
 

Dil09

New Member
Hi, Sorry that I explained less at the beginning. You are the best. This is what I wanted. Vielen Dank.
 
Top