Importing multiple text files containing a header and two columns into one sheet

[mifter]

Hi all,

I have been using a bit of VBA code that I found online to import many text files into one excel spreadsheet.

I have thousands of text files that contain a multi-line header, and then two columns of numerical data, tab delimited. I do not need to import the header, but I require the data to all be placed into seperate columns into a single spreadsheet.

Currently, with the code I am using, ONLY THE SECOND COLUMN of data gets imported into the spreadsheet. This is great for some of my needs, but sometimes I require BOTH columns to be put into excel.
I understand only the basics of VB and I am having trouble finding out which line of the code directs only the addition of the second column of data into my sheet. Can someone show me how to identify and modify it to bring in both? I would like the two columns of data (.txt) to come into seperate columns in the spreadsheet, ie, as A and B. Then, as the code loops through the next text file, it should bring in the next two columns of data into columns C and D, etc etc.

I would also like to know which line in this code brings in the name of my text file and places it as the first entry in the column. I like this, but cannot "see" it either.

Here it is:




Sub test()
Dim myDir As String, fn As String, ff As Integer, txt As String
Dim delim As String, n As Long, b(), flg As Boolean, x, t As Integer
myDir = "C:\Users\...."
delim = vbTab
fn = Dir(myDir & "\*.txt")
Do While fn <> ""
ReDim b(1 To Rows.Count, 1 To 1)
ff = FreeFile
Open myDir & "\" & fn For Input As #ff
Do While Not EOF(ff)
Line Input #ff, txt
x = Split(txt, delim)
If Not flg Then
n = n + 1: b(n, 1) = fn
End If
If UBound(x) > 0 Then
n = n + 1
b(n, 1) = x(1)
End If
flg = True
Loop
Close #ff
flg = False
t = t + 1
ThisWorkbook.Sheets(1).Cells(1, t).Resize.Value = b
n = 0
fn = Dir()
Loop
End Sub





Thanks so much for your help.​

 

[AlphaFrog]

Hi and welcome.

The macro below...

• Doesn't put the file name as the 1st entry
• Ignores the 1st line (header) in the txt file
• Reads two tab delimited columns for each text file

Sub test2()

    Dim myDir As String, fn As String, ff As Integer, txt As String
    Dim delim As String, n As Long, b() As Variant, x As Variant, t As Integer
    
    myDir = "C:\Users\...."
    delim = vbTab
    
    fn = Dir(myDir & "\*.txt")
    Do While fn <> ""
    
        ReDim b(1 To Rows.Count, 1 To 2)
        ff = FreeFile
        Open myDir & "\" & fn For Input As #ff
        
        Line Input #ff, txt  'Ignore header line
        
        Do While Not EOF(ff)
            Line Input #ff, txt
            x = Split(txt, delim)
            If UBound(x) > 0 Then
                n = n + 1
                b(n, 1) = x(0)
                b(n, 2) = x(1)
            End If
        Loop
        
        Close #ff
        ThisWorkbook.Sheets(1).Cells(1, 1 + t * 2).Resize(n, 2).Value = b
        t = t + 1
        n = 0
        fn = Dir()
        
    Loop
    
End Sub

 

[mifter]

That's awesome! I can kind of understand what you did. Thanks so much for cleaning this up.

In my original macro, I had the filename of the txt file show up in excel in the first cell, ie, A1, and then the relevant data show up below it. Is there a way I can get that back? I tried deleting the following line:

Line Input #ff, txt

but I think that only serves to ignore a single line of header, and so not what I want. Not sure what you changed that eliminates this?

Thanks again.

 

[AlphaFrog]

The red lines add the file name.

Sub test2()

    Dim myDir As String, fn As String, ff As Integer, txt As String[COLOR="Red"], flg As Boolean[/COLOR]
    Dim delim As String, n As Long, b() As Variant, x As Variant, t As Integer
    
    myDir = "C:\Users\...."
    delim = vbTab
    
    fn = Dir(myDir & "\*.txt")
    Do While fn <> ""
    
        ReDim b(1 To Rows.Count, 1 To 2)
        ff = FreeFile
        Open myDir & "\" & fn For Input As #ff
        
        Line Input #ff, txt  'Ignore header line
        
        Do While Not EOF(ff)
            Line Input #ff, txt
            x = Split(txt, delim)
[COLOR="Red"]            If Not flg Then
                n = n + 1: b(n, 1) = fn
                flg = True
            End If[/COLOR]
            If UBound(x) > 0 Then
                n = n + 1
                b(n, 1) = x(0)
                b(n, 2) = x(1)
            End If
        Loop
        
        Close #ff
        ThisWorkbook.Sheets(1).Cells(1, 1 + t * 2).Resize(n, 2).Value = b
        t = t + 1
        n = 0
        fn = Dir()
[COLOR="Red"]        flg = False[/COLOR]
        
    Loop
    
End Sub

 

[AlphaFrog]

Better yet...

Sub test2()

    Dim myDir As String, fn As String, ff As Integer, txt As String
    Dim delim As String, n As Long, b() As Variant, x As Variant, t As Integer
    
    myDir = "C:\Users\...."
    delim = vbTab
    
    fn = Dir(myDir & "\*.txt")
    Do While fn <> ""
    
        ReDim b(1 To Rows.Count, 1 To 2)
        ff = FreeFile
        Open myDir & "\" & fn For Input As #ff
        
        Line Input #ff, txt  'Ignore header line
        
        'File name
[COLOR="Red"]        n = n + 1
        b(n, 1) = fn[/COLOR]
        
        Do While Not EOF(ff)
            Line Input #ff, txt
            x = Split(txt, delim)
            If UBound(x) > 0 Then
                n = n + 1
                b(n, 1) = x(0)
                b(n, 2) = x(1)
            End If
        Loop
        
        Close #ff
        ThisWorkbook.Sheets(1).Cells(1, 1 + t * 2).Resize(n, 2).Value = b
        t = t + 1
        n = 0
        fn = Dir()
        
    Loop
    
End Sub

 

[mifter]

That is so cool. You have made me very happy. Honestly I never would have been able to do this with the level I am at right now.


I don't know if this is a question that should be made into a new thread or not, but it is related:

Is there a way to encode in the macro to only import certain text files?

For example, I am bringing into Excel data that I have acquired every 1 second, and I call the file names of the data ##_#####, where the first two digits are set for a certain experiment, and the following 5 are padding digits. The padding digits increase in increments of 1, where 1=1 second. So, I might have a bunch of files like, 15_00000, 15_00001, 15_00002, 15_00003, etc. The first is a time = 0 file, the second is after 1 second, the third is after 2, etc.

Say I only want to bring into Excel data every ten seconds. In other words, I only want the macro to bring in the following files: 15_00000 (an initial, or 'time zero') 15_00010, 15_00020, 15_00030, etc.. Can I write a line that tells the macro only to look for files of a certain form of file name?

If I should start a new thread please just let me know. Thanks so so much.

 

[AlphaFrog]

Sub test3()

    Dim myDir As String, fn As String, ff As Integer, txt As String
    Dim delim As String, n As Long, b() As Variant, x As Variant, t As Integer
    Dim ExpID As String, TPoint As Variant, Interval As Variant
    
    ExpID = Application.InputBox("Enter experiment ID number.", "Experiment ID", Type:=2)
    If ExpID = "False" Or ExpID = vbNullString Then Exit Sub
    
    TPoint = Application.InputBox("Enter the start time point in seconds.", "Start Time", 0, Type:=1)
    If TPoint = "False" Then Exit Sub
    
    Interval = Application.InputBox("Enter time interval in seconds.", "Time Interval", 10, Type:=1)
    If Interval = "False" Then Exit Sub
    
    myDir = "C:\Users\...."
    delim = vbTab
    
    fn = Dir(myDir & "\" & ExpID & "_" & Format(TPoint, "00000") & ".txt")
    If fn = "" Then MsgBox "Can't find file:" & vbCr & myDir & "\" & ExpID & "_" & Format(TPoint, "00000") & ".txt": Exit Sub
    
    Do While fn <> ""
    
        ReDim b(1 To Rows.Count, 1 To 2)
        ff = FreeFile
        Open myDir & "\" & fn For Input As #ff
        
        Line Input #ff, txt  'Ignore header line
        
        'Log File name
        n = n + 1
        b(n, 1) = fn
        
        Do While Not EOF(ff)
            Line Input #ff, txt
            x = Split(txt, delim)
            If UBound(x) > 0 Then
                n = n + 1
                b(n, 1) = x(0)
                b(n, 2) = x(1)
            End If
        Loop
        
        Close #ff
        ThisWorkbook.Sheets(1).Cells(1, 1 + t * 2).Resize(n, 2).Value = b
        t = t + 1
        n = 0
        
        TPoint = TPoint + Interval
        fn = Dir(myDir & "\" & ExpID & "_" & Format(TPoint, "00000") & ".txt")
        
    Loop
    
End Sub

 

[mifter]

hahahaha oh man! This is so cool. Everything I have ever wanted Excel to do..This is all data that I need for a paper I am writing and doing it any other way would take so so long.

I am trying to understand the code a little better. I truly want to be able to work with it on my own, and understand it..and not just, you know, post online and have someone do it for me everytime I want a small change.

1) Let's say I wanted to modify it to choose to ONLY import column 1 or column 2 from the txt files. (Like in the original macro I posted, where only 2 comes in to Excel). How do I change the code to do this?

2) When I put in the parameters, like experiment ID, start time, and interval, why does Excel prompt me when I run the macro? Doesn't the macro define the parameters for Excel, and so it shouldn't need to prompt me? Not that I really care..but I am curious.


This is honestly so unreal, I am blown away. Thank you so so much.

 

[mifter]

Hi alphadog, not sure if you had a minute or not to look at this, but I would really like to know how to change this script to import only the second column of data.

Thanks for all your help!!

 

[mifter]

I figured it out!

I needed to change

Close #ff
ThisWorkbook.Sheets(1).Cells(1, 1 + t * 2).Resize(n, 2).Value = b
t = t + 1
n = 0

to

Close #ff
ThisWorkbook.Sheets(1).Cells(1, 1 + t).Resize(n, 2).Value = b
t = t + 1
n = 0


Thanks!!!