Loop Through All text Files In A Given Folder open and save as excel file

Keala

New Member
Joined
Jul 9, 2018
Messages
37
[FONT=&quot]I'm new to VBA and wonder if anyone could suggest a solution to what I want to do. I have recorded it and have some understanding on how to do it. But it is semi-automated and I want to make it free from dependency to the file name on the *.txt files.
What I want to do is to open *.txt files in excel from a certain folder. The *.txt files are with tab-separation replace '.' with ',' move one of the columns in the now *.xls file (E:E) to a different open sheet Joined_282.xlsm save the opened *.xls file with same name as *.xls and close the file. Open next *.txt file in the folder do the same process but move the new copied column to the next column in the sheet A and so on, for all *.txt files in the folder.[/FONT]

[FONT=&quot]I have searched for opening *.txt file and save it as *.xls but not really find any that fulfill what I want to do. Hope you can suggest a suggestion or guide me to right place for understanding how to do it.
[/FONT]
[FONT=&quot]Thank you,

The recorded code looks like this:

[/FONT]
Sub Macro10()
'
' Macro10 Macro
'
' Keyboard Shortcut: Ctrl+n
'
ChDir _
"C:\Users\282_o\F_s"
Workbooks.OpenText Filename:= _
"C:\Users\282_o\F_s\Vpp1.txt" _
, Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), _
TrailingMinusNumbers:=True
Cells.Select
Selection.Replace What:=".", Replacement:=".", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Columns("E:E").Select
Selection.FormatConditions.AddTop10
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1)
.TopBottom = xlTop10Top
.Rank = 1
.Percent = False
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 10498160
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Selection.Copy
Windows("Joined_282.xlsm").Activate


Range("B1").Select
ActiveSheet.Paste

Range("B34").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "PC2"


Windows("Vpp1.txt").Activate
Application.CutCopyMode = False
ChDir _
"C:\Users\282_o\F_s\xls"
ActiveWorkbook.SaveAs Filename:= _
"C:\Users\282_o\F_s\xls\Vpp1.xlsx" _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWindow.Close

I have copied this code several time in the same macro but i need to change *.txt file manualy (vpp1.txt). I need a suggestion that can run this process but with out me need to change file name.
 

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.
Upvote 0
Thank you for your help to guide me to the links. The second link did take me a good step ahead. But the VBA-code save the files as *.xls files and I would want to save it as *.xlsx files since I'm running on Excel2016. If I only replace the *.xls with *.xlsx the saved files are corrupt and empty! I can handle that even if it is *.xls files, but could you please guide me on following:
I have let say nine *.xls files and I want to move one column from each *.xls file to a different file (we call it "joined_tst.xls"). So in this file nine column from B is populated with data from each *.xls file. I tried with below code, but when it reaches "Windows("joined_tst.xls").Activate" it give the alert code and stop the process. Could you please suggest why it does not proceed. Also could you please suggest how I can move one column forward by each file. (In highlighted code below I want it to be B1 from first file, B2 from second file, B3 from third and so one)


Sub Macro4()
'
' Macro4 Macro
'


'Private Sub CommandButton1_Click()
Dim MyFolder As String
Dim myfile As String
Dim folderName As String


With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
If .Show = -1 Then


folderName = .SelectedItems(1)
End If
End With


myfile = Dir(folderName & "\*.txt")


Do While myfile <> ""
Workbooks.OpenText Filename:=folderName & "" & myfile

Cells.Select
Selection.Replace What:=".", Replacement:=",", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Columns("E:E").Select
Selection.FormatConditions.AddTop10
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1)
.TopBottom = xlTop10Top
.Rank = 1
.Percent = False
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 10498160
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Selection.Copy
'Windows("joined_tst.xls").Activate




Range("B1").Select
ActiveSheet.Paste

Range("B34").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "PC2"







'save as excel file
ActiveWorkbook.SaveAs Filename:=folderName & "" & Replace(myfile, ".txt", ".xls")
'use below 3 lines if you want to close the workbook right after saving, so you dont have a lots of workbooks opened
Application.DisplayAlerts = False
ActiveWorkbook.Close
Application.DisplayAlerts = True
myfile = Dir
Loop
End Sub
'End Sub
 
Upvote 0
Thank you for your help to guide me to the links. The second link did take me a good step ahead. But the VBA-code save the files as *.xls files and I would want to save it as *.xlsx files since I'm running on Excel2016. If I only replace the *.xls with *.xlsx the saved files are corrupt and empty! I can handle that even if it is *.xls files
Just replace the format of the File SaveAs command in your new code with the structure you had in your original code.

So change this line:
Code:
[COLOR=#333333]ActiveWorkbook.SaveAs Filename:=folderName & "" & Replace(myfile, ".txt", ".xls")[/COLOR]
with this:
Code:
ActiveWorkbook.SaveAs Filename:=folderName & "" & Replace(myfile, ".txt", ".xlsx"), _    FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

I have let say nine *.xls files and I want to move one column from each *.xls file to a different file (we call it "joined_tst.xls"). So in this file nine column from B is populated with data from each *.xls file. I tried with below code, but when it reaches "Windows("joined_tst.xls").Activate" it give the alert code and stop the process
Do you have a file by that name open in the same Excel session? If not, it will result in an error.

Also note: Please use code tags when posting your code. It makes it much more readable.
See: https://www.mrexcel.com/forum/board-announcements/515787-how-post-your-vba-code.html
 
Upvote 0
Thank you for the suggestion on saving the file as well on adding code, I will make sure to use it.

Could you please define what you mean by "same Excel session"? I have the file "joined_tst.xlsx" open and in same folder as the rest of the files.

Could you please also let me know how I can move one column forward by each turn. I did notice I stated wrong in my previous statement. I want it to copy column (E:E) from file 1 paste it to column B in joined tst.xlsx, then copy column (E:E) from file 2 to column C in joined_tst.xls and so one. So move one column forward by each turn.
Thank you,
 
Upvote 0
Could you please define what you mean by "same Excel session"? I have the file "joined_tst.xlsx" open and in same folder as the rest of the files.
Depending on how you open your files, you could have multiple Excel sessions open on your computer. Any Excel file can only see/reference other files open in the SAME session. It cannot see files open in another Excel session.

One easy way to check to see if two Excel files are open in the same Excel session is to go into the VB Editor and look at all file names listed in the VB Project Explorer. It will show you all the files open in that particular Excel session.

Could you please also let me know how I can move one column forward by each turn. I did notice I stated wrong in my previous statement. I want it to copy column (E:E) from file 1 paste it to column B in joined tst.xlsx, then copy column (E:E) from file 2 to column C in joined_tst.xls and so one. So move one column forward by each turn.
There are a few ways you can do this. One handy tip is that VBA can reference Excel columns by letter or number (so "A"=1, "B"=2, "C"=3, ...).
So, as you loop through your files, you could increment a column counter than you can reference, i.e. if you are using the variable "c" for column, you would first initialize the value before your loop like this:
Code:
Dim c as Long
c = 2
Then within your loop, you can reference the cell you want to paste to by using Cells(row,column) notation instead of Range(...).
So to reference cell B1, it would look like:
Code:
Cells(1,c)
(which is equivalent to Range("B2") when c = 2.
And then before the end of your loop, you increment the counter like this:
Code:
c = c + 1

Alternatively, within your loop, you could dynamically find the last populated column in row 1 and move over one column, like this:
Code:
Cells(1, Columns.Count).End(xlToLeft).Offset(0,1)

Either way should work. Its just a matter of personal preference.
 
Upvote 0
Thank you so much for your help. Now I have working program with basically all functionality I want. :biggrin:
 
Upvote 0
Excellent! I am glad to hear it.:)
 
Upvote 0
I'm not sure if I should start a new thread or I can continue on last one, since the question is along the same code.

I have the code below which do basically the things I want beside one thing which I can't really figure out how to solve it. I have let say 40 *.xls files in the folder, I have also a *.xlsm file with eight sheets named (PC2,4,6...-16) in the same folder; I want to copy the column E from the first *.xls file to the "joined_test.xlsm" sheet PC2(sheet1) column B, then copy column E from *.xls file 2 to "joined_test.xlsm" sheet PC4(sheet2) column B do this until file 8 column E is copied to sheet PC16(sheet8) column B. Then copy column E from file 9 to "joined_test.xlsm" sheet PC2(sheet1) column C and so on until 8 sheets five columns on each sheet is populated with values.

Different way to achieve the same result would be to do this instead: From *.xls file 1 copy column E to "joined_test.xlsm" sheet PC2 (sheet1) column B, then open *.xls file 9 and copy column E to "joined_test.xlsm" sheet PC2(sheet1) column C and so on until 8 columns are populated with values in sheet PC2(sheet1). Then select *.xls file 2 copy column E to "joined_test.xlsm" sheet PC4 column B, then copy column E from *.xls file 10 to sheet PC4 column C and so on.

So to keep the column the same and change sheet for every new open *.xls file or to keep the same sheet and change column for every new open *.xls file, the result of both should be the same.

I guess I need to have some kind of loop in the loop solution, but not really sure how to do that. I appreciate all the help. (I have purple marked the part in the code which I think need to be improved)

Rich (BB code):
Dim MyFolder As String
 Dim myfile As String
 Dim folderName As String
 Dim c As Long
 Dim k As Long
 c = 2
 k = 2


 With Application.FileDialog(msoFileDialogFolderPicker)
 .AllowMultiSelect = False
 If .Show = -1 Then


 folderName = .SelectedItems(1)
 End If
 End With


 myfile = Dir(folderName & "\*.txt")
 
 Do While myfile <> ""
 Workbooks.OpenText Filename:=folderName & "\" & myfile, Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
        Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), _
        TrailingMinusNumbers:=True
 Cells.Select
    Selection.Replace What:=".", Replacement:=".", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    
    Columns("E:E").Select
    Selection.FormatConditions.AddTop10
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1)
        .TopBottom = xlTop10Top
        .Rank = 1
        .Percent = False
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 10498160
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    ActiveWorkbook.SaveAs Filename:=folderName & "\" & Replace(myfile, ".txt", ".xlsx"), FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    Selection.Copy
     
    'Windows("Joined_test.xlsm").Activate
    Workbooks("Joined_test.xlsm").Sheets("PC" & k).Activate
    Cells(1, c).EntireColumn.Select
    ActiveSheet.Paste
    Cells(34, c).Select
    ActiveCell.FormulaR1C1 = "CC" & k
    c = c + 1
    k = k + 2


      
    'Ensure Workbook has closed before moving on to next line of code
      DoEvents


    'Get next file name
      myfile = Dir
  Loop
  
    For Each wb In Workbooks
        If wb.Name <> ThisWorkbook.Name Then
            'wb.SaveAs Filename:=Path & wb.Name
            ', FileFormat:=51
           wb.Close False
        End If
    Next wb
    'ThisWorkbook.Close False
    
'Message Box when tasks are completed
  MsgBox "Task Complete!"
      
ResetSettings:
  'Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
 
End Sub
 
Upvote 0
I'm not sure if I should start a new thread or I can continue on last one, since the question is along the same code.
The general rule of thumb is this:
If it is a new question (even if it is on the same project), then post it to a new thread so it shows up as a new, unanswered question.
Only post to the the same thread if it is a follow-up question that is dependent upon the previous response (i.e. without the prior knowledge, the responder would not need be able to answer your question).

It looks like your new question can stand on its own, so I would recommend posting it to a new thread.
 
Upvote 0

Forum statistics

Threads
1,213,527
Messages
6,114,148
Members
448,552
Latest member
WORKINGWITHNOLEADER

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
Back
Top