Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Importing multiple text files to 1 spreadsheet
How can i import up to 100 files into the same spreadsheet from:
Filename1.txt Freq [Hz] dBSPL Phase [Deg] 20.00 116.25 -101.80 20.56 115.78 -73.43 21.13 115.11 -46.75 21.71 113.43 -10.13 22.32 111.14 11.57 22.94 107.99 12.61 23.58 104.44 -0.59 24.23 103.51 -17.97 Filename2.txt Freq [Hz] dBSPL Phase [Deg] 20.00 114.85 -87.46 20.56 114.33 -114.88 21.13 113.59 -138.83 21.71 111.82 -170.68 22.32 109.53 169.09 22.94 106.39 154.78 23.58 103.27 138.49 24.23 102.07 127.61 ETC... when done the final spreadsheet looks like this. Freq [Hz] Filename1 Filename2 Filename3 20 116.25 114.85 112.32 20.56 115.78 114.33 111.84 21.13 115.11 113.59 111.17 21.71 113.43 111.82 109.62 22.32 111.14 109.53 107.61 22.94 107.99 106.39 105.03 23.58 104.44 103.27 102.69 24.23 103.51 102.07 101.7 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Importing multiple text files to 1 spreadsheet
If you want each txt file in another column Try this example
Change the folder in this code line in the macro 'Fill in the path\folder where the files are MyPath = "C:\Users\Ron\test" This example copy 2000 cells Sub Example() Dim MyPath As String, FilesInPath As String Dim MyFiles() As String Dim SourceCcount As Long, Fnum As Long Dim mybook As Workbook, BaseWks As Worksheet Dim sourceRange As Range, destrange As Range Dim Cnum As Long, CalcMode As Long 'Fill in the path\folder where the files are MyPath = "C:\Users\Ron\test" 'Add a slash at the end if the user forget it If Right(MyPath, 1) < "\" Then MyPath = MyPath & "\" End If 'If there are no txt files in the folder exit the sub FilesInPath = Dir(MyPath & "*.txt") If FilesInPath = "" Then MsgBox "No files found" Exit Sub End If 'Fill the array(myFiles)with the list of txt files in the folder Fnum = 0 Do While FilesInPath < "" Fnum = Fnum + 1 ReDim Preserve MyFiles(1 To Fnum) MyFiles(Fnum) = FilesInPath FilesInPath = Dir() Loop 'Change ScreenUpdating, Calculation and EnableEvents With Application CalcMode = .Calculation .Calculation = xlCalculationManual .ScreenUpdating = False .EnableEvents = False End With 'Add a new workbook with one sheet Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1) Cnum = 1 'Loop through all files in the array(myFiles) If Fnum 0 Then For Fnum = LBound(MyFiles) To UBound(MyFiles) Set mybook = Nothing On Error Resume Next Workbooks.OpenText Filename:=MyPath & MyFiles(Fnum), Origin:=xlWindows, StartRow _ :=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _ ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=True, _ Space:=False, Other:=False Set mybook = ActiveWorkbook On Error GoTo 0 If Not mybook Is Nothing Then On Error Resume Next Set sourceRange = mybook.Worksheets(1).Range("A1:A2000") If Err.Number 0 Then Err.Clear Set sourceRange = Nothing Else 'if SourceRange use all rows then skip this file If sourceRange.Rows.Count = BaseWks.Rows.Count Then Set sourceRange = Nothing End If End If On Error GoTo 0 If Not sourceRange Is Nothing Then SourceCcount = sourceRange.Columns.Count If Cnum + SourceCcount = BaseWks.Columns.Count Then MsgBox "Sorry there are not enough columns in the sheet" BaseWks.Columns.AutoFit mybook.Close savechanges:=False GoTo ExitTheSub Else 'Copy the file name in the first row With sourceRange BaseWks.Cells(1, Cnum). _ Resize(, .Columns.Count).Value = MyFiles(Fnum) End With 'Set the destrange Set destrange = BaseWks.Cells(2, Cnum) 'we copy the values from the sourceRange to the destrange With sourceRange Set destrange = destrange. _ Resize(.Rows.Count, .Columns.Count) End With destrange.Value = sourceRange.Value Cnum = Cnum + SourceCcount End If End If mybook.Close savechanges:=False End If Next Fnum BaseWks.Columns.AutoFit End If ExitTheSub: 'Restore ScreenUpdating, Calculation and EnableEvents With Application .ScreenUpdating = True .EnableEvents = True .Calculation = CalcMode End With End Sub -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "jeffg11" wrote in message ... How can i import up to 100 files into the same spreadsheet from: Filename1.txt Freq [Hz] dBSPL Phase [Deg] 20.00 116.25 -101.80 20.56 115.78 -73.43 21.13 115.11 -46.75 21.71 113.43 -10.13 22.32 111.14 11.57 22.94 107.99 12.61 23.58 104.44 -0.59 24.23 103.51 -17.97 Filename2.txt Freq [Hz] dBSPL Phase [Deg] 20.00 114.85 -87.46 20.56 114.33 -114.88 21.13 113.59 -138.83 21.71 111.82 -170.68 22.32 109.53 169.09 22.94 106.39 154.78 23.58 103.27 138.49 24.23 102.07 127.61 ETC... when done the final spreadsheet looks like this. Freq [Hz] Filename1 Filename2 Filename3 20 116.25 114.85 112.32 20.56 115.78 114.33 111.84 21.13 115.11 113.59 111.17 21.71 113.43 111.82 109.62 22.32 111.14 109.53 107.61 22.94 107.99 106.39 105.03 23.58 104.44 103.27 102.69 24.23 103.51 102.07 101.7 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Importing multiple text files to 1 spreadsheet
The code will read every text file (*.txt) in the Folder = "C:\temp\test2\"
(change folder as required). The code creates two worksheets Input, and Summary. The code uses a Query to input the data t the worksheet Input. then moves the data to the summary worksheet. then clears the input sheet and repeats the process until all the files are read. Then the code performs a sort on the frequency incase not all frequencies are in each of the files. If you run the code more than once you have to delete the Input and Summary worksheet or remove the code that adds these two worksheets. Otherwise you get an error because you can't create two worksheets with the same name. Sub Macro1() Folder = "C:\temp\test2\" With ThisWorkbook Set InputSht = Worksheets.Add( _ after:=.Sheets(.Sheets.Count)) InputSht.Name = "Input" Set SummarySht = Worksheets.Add( _ after:=.Sheets(.Sheets.Count)) SummarySht.Name = "Summary " SummarySht.Range("A1") = "Freq [Hz]" End With ColCount = 2 NewRow = 2 FName = Dir(Folder & "*.txt") Do While FName < "" 'Input data file With InputSht .Cells.ClearContents With .QueryTables.Add( _ Connection:="TEXT;" & Folder & FName, _ Destination:=.Range("A1")) .Name = FName .SaveData = True .AdjustColumnWidth = True .TextFileStartRow = 1 .TextFileParseType = xlFixedWidth .TextFileColumnDataTypes = Array(1, 1, 1) .TextFileFixedColumnWidths = Array(16, 10) .Refresh BackgroundQuery:=False End With 'Move Data to Sumary sheet SummarySht.Cells(1, ColCount) = FName RowCount = 2 Do While .Range("A" & RowCount) < "" Frequency = .Range("A" & RowCount) dbSPL = .Range("B" & RowCount) With SummarySht Set c = .Columns("A").Find(what:=Frequency, _ LookIn:=xlValues, lookat:=xlWhole) If c Is Nothing Then .Range("A" & NewRow) = Frequency .Cells(NewRow, ColCount) = dbSPL NewRow = NewRow + 1 Else .Cells(c.Row, ColCount) = dbSPL End If End With RowCount = RowCount + 1 Loop End With ColCount = ColCount + 1 FName = Dir() Loop 'sort data With SummarySht Set SortRange = .Range(Range("A1"), _ Cells(RowCount - 1, ColCount - 1)) SortRange.Sort _ Key1:=Range("A1"), _ Order1:=xlAscending, _ Header:=xlYes SortRange.Columns.AutoFit End With End Sub "jeffg11" wrote: How can i import up to 100 files into the same spreadsheet from: Filename1.txt Freq [Hz] dBSPL Phase [Deg] 20.00 116.25 -101.80 20.56 115.78 -73.43 21.13 115.11 -46.75 21.71 113.43 -10.13 22.32 111.14 11.57 22.94 107.99 12.61 23.58 104.44 -0.59 24.23 103.51 -17.97 Filename2.txt Freq [Hz] dBSPL Phase [Deg] 20.00 114.85 -87.46 20.56 114.33 -114.88 21.13 113.59 -138.83 21.71 111.82 -170.68 22.32 109.53 169.09 22.94 106.39 154.78 23.58 103.27 138.49 24.23 102.07 127.61 ETC... when done the final spreadsheet looks like this. Freq [Hz] Filename1 Filename2 Filename3 20 116.25 114.85 112.32 20.56 115.78 114.33 111.84 21.13 115.11 113.59 111.17 21.71 113.43 111.82 109.62 22.32 111.14 109.53 107.61 22.94 107.99 106.39 105.03 23.58 104.44 103.27 102.69 24.23 103.51 102.07 101.7 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Importing multiple text files to 1 spreadsheet
This was perfect!! I cutpasted your suggestion directy into a macro and it
worked the 1st time. You saved me hours & I can't thank you enough! jg "Joel" wrote: The code will read every text file (*.txt) in the Folder = "C:\temp\test2\" (change folder as required). The code creates two worksheets Input, and Summary. The code uses a Query to input the data t the worksheet Input. then moves the data to the summary worksheet. then clears the input sheet and repeats the process until all the files are read. Then the code performs a sort on the frequency incase not all frequencies are in each of the files. If you run the code more than once you have to delete the Input and Summary worksheet or remove the code that adds these two worksheets. Otherwise you get an error because you can't create two worksheets with the same name. Sub Macro1() Folder = "C:\temp\test2\" With ThisWorkbook Set InputSht = Worksheets.Add( _ after:=.Sheets(.Sheets.Count)) InputSht.Name = "Input" Set SummarySht = Worksheets.Add( _ after:=.Sheets(.Sheets.Count)) SummarySht.Name = "Summary " SummarySht.Range("A1") = "Freq [Hz]" End With ColCount = 2 NewRow = 2 FName = Dir(Folder & "*.txt") Do While FName < "" 'Input data file With InputSht .Cells.ClearContents With .QueryTables.Add( _ Connection:="TEXT;" & Folder & FName, _ Destination:=.Range("A1")) .Name = FName .SaveData = True .AdjustColumnWidth = True .TextFileStartRow = 1 .TextFileParseType = xlFixedWidth .TextFileColumnDataTypes = Array(1, 1, 1) .TextFileFixedColumnWidths = Array(16, 10) .Refresh BackgroundQuery:=False End With 'Move Data to Sumary sheet SummarySht.Cells(1, ColCount) = FName RowCount = 2 Do While .Range("A" & RowCount) < "" Frequency = .Range("A" & RowCount) dbSPL = .Range("B" & RowCount) With SummarySht Set c = .Columns("A").Find(what:=Frequency, _ LookIn:=xlValues, lookat:=xlWhole) If c Is Nothing Then .Range("A" & NewRow) = Frequency .Cells(NewRow, ColCount) = dbSPL NewRow = NewRow + 1 Else .Cells(c.Row, ColCount) = dbSPL End If End With RowCount = RowCount + 1 Loop End With ColCount = ColCount + 1 FName = Dir() Loop 'sort data With SummarySht Set SortRange = .Range(Range("A1"), _ Cells(RowCount - 1, ColCount - 1)) SortRange.Sort _ Key1:=Range("A1"), _ Order1:=xlAscending, _ Header:=xlYes SortRange.Columns.AutoFit End With End Sub "jeffg11" wrote: How can i import up to 100 files into the same spreadsheet from: Filename1.txt Freq [Hz] dBSPL Phase [Deg] 20.00 116.25 -101.80 20.56 115.78 -73.43 21.13 115.11 -46.75 21.71 113.43 -10.13 22.32 111.14 11.57 22.94 107.99 12.61 23.58 104.44 -0.59 24.23 103.51 -17.97 Filename2.txt Freq [Hz] dBSPL Phase [Deg] 20.00 114.85 -87.46 20.56 114.33 -114.88 21.13 113.59 -138.83 21.71 111.82 -170.68 22.32 109.53 169.09 22.94 106.39 154.78 23.58 103.27 138.49 24.23 102.07 127.61 ETC... when done the final spreadsheet looks like this. Freq [Hz] Filename1 Filename2 Filename3 20 116.25 114.85 112.32 20.56 115.78 114.33 111.84 21.13 115.11 113.59 111.17 21.71 113.43 111.82 109.62 22.32 111.14 109.53 107.61 22.94 107.99 106.39 105.03 23.58 104.44 103.27 102.69 24.23 103.51 102.07 101.7 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Importing Multiple Text Files | Excel Programming | |||
Importing multiple text files to worksheets | Excel Programming | |||
Importing multiple files into spreadsheet | Excel Programming | |||
Importing from multiple text files | Excel Programming | |||
importing multiple text files??? | Excel Discussion (Misc queries) |