help with macro to read and sort data from multiple text files

[jsinghprof1]

Hello there !!

Reposting my request.

I have x number of ascii text files that have space delimited data
columns (files may have 3 to 40 data columns). There are about 25
header rows at the top of each file but I am not going to use info
from these rows. I also have a master.xls file. Could someone please
help me create a macro to do the following -


A) read first *.txt file from the given folder into sheet1 of the
master.xls file.


NOTE: I have already set up the sheet2 of the master.xls to sort
required rows of data from sheet1 (based on row headers) using
vlookup
to populate a 40 column wide array.


B) Copy the sorted array of cells from sheet2 that have numbers in
them (since the number of columns in the text files vary, I may have
cells in sheet2 that have #REF! in them if the number of columns to
be
read from sheet1 are less than 40) and paste (values only) into
sheet3


C) clear the contents of sheet1


D) repeat (A) for second *.txt file


E) Copy the sorted array of cells from sheet2 that have numbers in
them and paste (values only) into sheet3 appending to the right of
the
columns that were already in sheet3


F) repeat (D) and (E) untill all the *.txt files have been read


thanks!!


jkagg

 

[Joel]

Change MyPath to match the location of your txt files

Sub GetTextFiles()
Const MyPath = "D:\temp"

Set fs = Application.FileSearch
With fs
.LookIn = MyPath
.Filename = "*.txt"
End With

If fs.Execute(SortBy:=msoSortByFileName, _
SortOrder:=msoSortOrderAscending) > 0 Then

For i = 1 To fs.FoundFiles.Count
With Worksheets("Sheet1").QueryTables. _
Add(Connection:="TEXT;" + fs.FoundFiles(i), _
Destination:=Worksheets("Sheet1").Range("A1"))
.Name = fs.FoundFiles(i)
.FieldNames = True
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileCommaDelimiter = True
.TextFileColumnDataTypes = _
Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With

'copy sheet 2
LastColumn2 = Worksheets("Sheet2"). _
Cells(1, Columns.Count).End(xlToLeft).Column
Lastrow2 = Worksheets("Sheet2"). _
Cells(Rows.Count, 1).End(xlUp).Row

PasteColumn = Worksheets("Sheet3"). _
Cells(1, Columns.Count).End(xlToLeft).Column

'add one to paste column except if pasting in column A
If PasteColumn = 1 Then
If Not IsEmpty(Worksheets("Sheet3").Cells(1, 1)) Then
PasteColumn = 2
End If
Else
PasteColumn = PasteColumn + 1
End If

Worksheets("Sheet2").Activate
Set CopyRange = Worksheets("Sheet2"). _
Range(Cells(1, 1), Cells(Lastrow2, LastColumn2))

Set PasteRange = Worksheets("Sheet3"). _
Cells(1, PasteColumn)

CopyRange.Copy Destination:=PasteRange

Set MyQueryTable = Worksheets("Sheet1").QueryTables
For j = 1 To (MyQueryTable.Count - 1)
MyQueryTable(j).Delete
Next j

Worksheets("sheet1").Activate
Worksheets("sheet1").Cells.Select
Selection.ClearContents
Worksheets("sheet1").Cells(1, 1).Select

Next i
Else
MsgBox "There were no files found."
End If

End Sub

 

[jsinghprof1]

Thanks Joel very much !! I will try it and let you know how it worked.

jkagg

 

[jsinghprof1]

Joel,

This is regarding my post on " microsoft.public.excel.programming"
3/16/07 with above subject. I am adapting your VBScript to work for me
but still have some issues that I have not been able to resolve. Is it
OK if I send you my files (.xls, .dat) if you give an email address so
you can help me out?

thank you very much for your help

Jay