import from .txt to new excel file

[lucigen]

hey guys,

so first things first, I dont really know what im doing here...

the object is to use this excel file to get a folder location. Within that folder will be a bunch of .txt files (data seperate with tab) having a keyword in them (key 1-6). I want to somehow copy everything except for the first row in the .txt file to a sheet in an excel sheet where the key number corresponds to the sheet number (key 3 found means data goes to sheet 3). It would also be really awesome if all of the data went into a seperate .xlsx file and then got saved in whatever directory.

here is my frankenstein attempt at a general code

Sub ReadWrite()
    Dim sPath As String
    Dim sFilename As String
    Dim sToFilename As String
    Dim key1, key2, key3, key4, key5, key6 As String
    Dim toWkBk As Workbook
    Dim sht1, sht2, sht3, sht4, sht5, sht6 As Worksheet
    
    
    Set toWkBk = Workbooks.Add
    Set sht1 = Worksheets.Add
    Set sht2 = Worksheets.Add
    Set sht3 = Worksheets.Add
    Set sht4 = Worksheets.Add
    Set sht5 = Worksheets.Add
    Set sht6 = Worksheets.Add
    
    
    key1 = "one"
    key2 = "two"
    key3 = "three"
    key4 = "four"
    key5 = "five"
    key6 = "blargh"
    
 
    sPath = Sheets(1).Range("B3").Value
 
    If Right(sPath, 1) <> "\" Then
        sPath = sPath & "\"
    End If
    
    sFilename = Dir(sPath & "*.txt")
    
    Do Until sFilename = ""
        If InStr(1, sFilename, key1, vbTextCompare) > 0 Then
            'copy .txt to excel sheet 1 with all but header row
            'towkbk.sht1. somethingrather?
        Else
            If InStr(1, sFilename, key2, vbTextCompare) > 0 Then
                'copy .txt to excel sheet 2 with all but header row
            Else
                If InStr(1, sFilename, key3, vbTextCompare) > 0 Then
                    'copy .txt to excel sheet 3 with all but header row
                Else
                    If InStr(1, sFilename, key4, vbTextCompare) > 0 Then
                        'copy .txt to excel sheet 4 with all but header row
                    Else
                        If InStr(1, sFilename, key5, vbTextCompare) > 0 Then
                            'copy .txt to excel sheet 5 with all but header row
                        Else
                            'copy .txt to excel sheet 6 with all but header row
                        End If
                    End If
                End If
            End If
        End If
    Loop
    
    toWkBk.SaveAs Filename:="C:/" & sToFilename
        
End Sub

its worth noting that I'm pretty nub when it comes to opening, closing, saving other files from a vb macro. If you know of any general location of information about that kind of stuff, I would be very thankful.

Also if you do know how to do this, can you please comment out whatever you do so that I can figure out what on earth is going on?

Thanks Gurus!

 

[CharlesChuckieCharles]

code in RED

This should work nicely

you'll have to finish off the iterations of the different sheets

sToFilename needs a value

Sub ReadWrite()
    Dim sPath As String
    Dim sFilename As String
    Dim sToFilename As String
    Dim key1, key2, key3, key4, key5, key6 As String
    Dim toWkBk As Workbook
    Dim sht1 As Worksheet, sht2 As Worksheet, sht3 As Worksheet, sht4 As Worksheet, sht5 As Worksheet, sht6 As Worksheet
 
 
    Set toWkBk = Workbooks.Add
    Set sht1 = Worksheets.Add
    Set sht2 = Worksheets.Add
    Set sht3 = Worksheets.Add
    Set sht4 = Worksheets.Add
    Set sht5 = Worksheets.Add
    Set sht6 = Worksheets.Add
 
 
    key1 = "qry"
    key2 = "two"
    key3 = "three"
    key4 = "four"
    key5 = "five"
    key6 = "blargh"
 
 
    sPath = Sheets(1).Range("B3").Value
 
    If Right(sPath, 1) <> "\" Then
        sPath = sPath & "\"
    End If
 
 
 
    sFilename = Dir(sPath & "*.txt")
    [COLOR=red]Application.DisplayAlerts = false[/COLOR]
    Do Until sFilename = ""
        If InStr(1, sFilename, key1, vbTextCompare) > 0 Then
[COLOR=red]          Call processFile(sPath & sFilename, toWkBk, sht1)[/COLOR]
           'copy .txt to excel sheet 1 with all but header row
            'towkbk.sht1. somethingrather?
        Else
            If InStr(1, sFilename, key2, vbTextCompare) > 0 Then
                'copy .txt to excel sheet 2 with all but header row
            Else
                If InStr(1, sFilename, key3, vbTextCompare) > 0 Then
                    'copy .txt to excel sheet 3 with all but header row
                Else
                    If InStr(1, sFilename, key4, vbTextCompare) > 0 Then
                        'copy .txt to excel sheet 4 with all but header row
                    Else
                        If InStr(1, sFilename, key5, vbTextCompare) > 0 Then
                            'copy .txt to excel sheet 5 with all but header row
                        Else
                            'copy .txt to excel sheet 6 with all but header row
                        End If
                    End If
                End If
            End If
        End If
[COLOR=red]  sFilename = Dir[/COLOR]
 
 
    Loop
 
    [COLOR=red]Application.DisplayAlerts = true[/COLOR]
    toWkBk.SaveAs FileName:="C:/" & sToFilename
 
End Sub

[COLOR=red]Sub processFile(sFiletoOpen As String, TargetWorkBook As Workbook, Targetsheet As Worksheet)[/COLOR]
 
 
[COLOR=red]Dim CurrentRecWorkBook As Workbook[/COLOR]
 
[COLOR=red]         'open tesxt file into temp work book [/COLOR]
[COLOR=red]          Set CurrentRecWorkBook = Workbooks.Open(sFiletoOpen, UpdateLinks:=0)[/COLOR]
[COLOR=red]          CurrentRecWorkBook.Activate[/COLOR]
[COLOR=red]          ActiveSheet.Cells().Copy[/COLOR]
[COLOR=red]'switch to target workbook[/COLOR]
[COLOR=red]          TargetWorkBook.Activate[/COLOR]
[COLOR=red]'switch to target sheet[/COLOR]
[COLOR=red]          Targetsheet.Activate[/COLOR]
[COLOR=red]'paste in text file data[/COLOR]
[COLOR=red]          ActiveSheet.Paste[/COLOR]
[COLOR=red]'delete first row[/COLOR]
[COLOR=red]          ActiveSheet.Rows(1).Delete[/COLOR]
 
[COLOR=red]'select first column of data ( for the text to columns function[/COLOR]
[COLOR=red]          ActiveSheet.Columns(1).Select[/COLOR]
[COLOR=red]'do a text to columns    THIS may NOT Be Necessary[/COLOR]
 
[COLOR=red]          Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _[/COLOR]
[COLOR=red]              TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _[/COLOR]
[COLOR=red]              Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _[/COLOR]
[COLOR=red]              :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _[/COLOR]
[COLOR=red]              Array(7, 1), Array(8, 1)), TrailingMinusNumbers:=True[/COLOR]
 
[COLOR=red]      ' close and kill temp workbook        [/COLOR]
[COLOR=red]          CurrentRecWorkBook.Close (False)[/COLOR]
[COLOR=red]          Set CurrentRecWorkBook = Nothing[/COLOR]
 
[COLOR=red]End Sub[/COLOR]

 

[lucigen]

Hey thanks!

I actually spent a large portion of my evening trying to figure this out, and I arrived at roughly the same code although not quite as nice looking. It did have to be modified though because the keys might get hit more than once so it has to go to the last row and then paste in the new data (thats why the 1st header row is omitted, so that these things can just become giant flat files of data).

So while I didn't actually use your code word for word (its a pride thing) It did help me solve a number of problems in my own code, Thank you sir!

One quick question now regarding opening and closing files though

the .close (false) thing got vba really confused, and I am a little confused on the whole opening/close files thing. This is what I am doing minus all the other parts of code

Dim xlApp As Excel.Application
Dim xlSht As Excel.Worksheet
Do Until sFilename = ""
        Set xlApp = New Excel.Application
        xlApp.Workbooks.Open (sPath & sFilename)
        'stuff
        Set xlSht = Nothing
        Set xlApp = Nothing
        sFilename = Dir
Loop
xlApp.Quit

is that acceptable practice in terms of opening/closing stuff? What can or should I be doing to make it better?

Thanks again though!!!

 

[CharlesChuckieCharles]

Not sure theres any point in

Dim xlApp As Excel.Application

if your using Excel vba because its already implied

if you open something you should close it (False is really SaveChanges:=False) but only applies to objects that can save changes

= Nothing releases the memory used by the object (destroying it) Very good Practise

If you don't understand the parameters for a method the use HELP