Hello,

The following macro (thanks to Tom O.), will copy a single column of
data from many text files (*.mhl extension) onto the same worksheet.
Now, I have over 1000 of these text files. The macro works until the
first 256 columns of the first worksheet are filled and then it
produces an error. I know that you cannot add more than 256 columns.
So how do I carry on filling columns of subsequent worksheets for all
1000 files???

Many thanks,

Bharesh


Option Explicit

Sub Getmhl()
Dim wkbk As Workbook
Dim shDest As Worksheet
Dim col As Long
Dim i As Long
Dim rng As Range
Dim rng1 As Range
Dim rng2 As Range

Set shDest = ThisWorkbook.ActiveSheet
shDest.UsedRange.ClearContents
col = 1
With Application.FileSearch
.NewSearch
.LookIn = "C:\Documents and Settings\My Documents"
.SearchSubFolders = False
.FileName = "*.mhl"
.FileType = msoFileTypeAllFiles

If .Execute() 0 Then
For i = 1 To .FoundFiles.Count

Workbooks.OpenText _
FileName:=.FoundFiles(i) ' _
' 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
Set wkbk = ActiveWorkbook
With wkbk.Worksheets(1)
Set rng = .Range(.Cells(1, 1), _
.Cells(Rows.Count, 1).End(xlUp))
End With
rng.Copy Destination:=shDest.Cells(2, col)
shDest.Cells(1, col) = wkbk.Name
Set rng1 = shDest.Cells(Rows.Count, col).End(xlUp)(2)
Set rng2 = shDest.Range(shDest.Cells(2, col), rng1(0))
rng1.Formula = "=Average(" & rng2.Address & ")"
rng1(2).Formula = "=Stdev(" & rng2.Address & ")"
rng1(3).Formula = "=Count(" & rng2.Address & ")"
wkbk.Close SaveChanges:=False
col = col + 1
Next i
Else
MsgBox "There were no files found."
End If
End With
End Sub

m4nd4li4


Try this modification.

Adds a new sheet once col count = or greater than 256




Sub Getmhl()
Dim wkbk As Workbook
Dim shDest As Worksheet
Dim col As Long
Dim i As Long
Dim rng As Range
Dim rng1 As Range
Dim rng2 As Range

Set shDest = ThisWorkbook.ActiveSheet
shDest.UsedRange.ClearContents
col = 1
With Application.FileSearch
.NewSearch
.LookIn = "C:\Documents and Settings\My Documents"
.SearchSubFolders = False
.FileName = "*.mhl"
.FileType = msoFileTypeAllFiles

If .Execute() 0 Then
For i = 1 To .FoundFiles.Count

Workbooks.OpenText _
FileName:=.FoundFiles(i) ' _
' 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
Set wkbk = ActiveWorkbook
With wkbk.Worksheets(1)
Set rng = .Range(.Cells(1, 1), _
.Cells(Rows.Count, 1).End(xlUp))
End With
rng.Copy Destination:=shDest.Cells(2, col)
shDest.Cells(1, col) = wkbk.Name
Set rng1 = shDest.Cells(Rows.Count, col).End(xlUp)(2)
Set rng2 = shDest.Range(shDest.Cells(2, col), rng1(0))
rng1.Formula = "=Average(" & rng2.Address & ")"
rng1(2).Formula = "=Stdev(" & rng2.Address & ")"
rng1(3).Formula = "=Count(" & rng2.Address & ")"
wkbk.Close SaveChanges:=False
If col < 256 Then
col = col + 1
Else
ThisWorkbook.Sheets.Add Befo=Worksheets(1)
End If
Next i
Else
MsgBox "There were no files found."
End If
End With
End Su

--
Message posted from http://www.ExcelForum.com

Hello,

Many thanks for the reply. Unfortunately there is a but!! After all
256 columns are filled on the first sheet, it does adds lots and lots
of BLANK sheets, that the number of sheets it adds is equal to the
number of text files in the directory. I wanted the second sheet to be
filled, to 256 columns, with the contents of the text files. Once all
256 columns are filled, I would like to do the same for the third
sheet, etc, etc...... Any suggestions???

Regards,

Bharesh


mudraker wrote in message
...
m4nd4li4


Try this modification.

Adds a new sheet once col count = or greater than 256




Sub Getmhl()
Dim wkbk As Workbook
Dim shDest As Worksheet
Dim col As Long
Dim i As Long
Dim rng As Range
Dim rng1 As Range
Dim rng2 As Range

Set shDest = ThisWorkbook.ActiveSheet
shDest.UsedRange.ClearContents
col = 1
With Application.FileSearch
.NewSearch
.LookIn = "C:\Documents and Settings\My Documents"
.SearchSubFolders = False
.FileName = "*.mhl"
.FileType = msoFileTypeAllFiles

If .Execute() 0 Then
For i = 1 To .FoundFiles.Count

Workbooks.OpenText _
FileName:=.FoundFiles(i) ' _
' 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
Set wkbk = ActiveWorkbook
With wkbk.Worksheets(1)
Set rng = .Range(.Cells(1, 1), _
.Cells(Rows.Count, 1).End(xlUp))
End With
rng.Copy Destination:=shDest.Cells(2, col)
shDest.Cells(1, col) = wkbk.Name
Set rng1 = shDest.Cells(Rows.Count, col).End(xlUp)(2)
Set rng2 = shDest.Range(shDest.Cells(2, col), rng1(0))
rng1.Formula = "=Average(" & rng2.Address & ")"
rng1(2).Formula = "=Stdev(" & rng2.Address & ")"
rng1(3).Formula = "=Count(" & rng2.Address & ")"
wkbk.Close SaveChanges:=False
If col < 256 Then
col = col + 1
Else
ThisWorkbook.Sheets.Add Befo=Worksheets(1)
End If
Next i
Else
MsgBox "There were no files found."
End If
End With
End Sub


---
Message posted from http://www.ExcelForum.com/

On 4 Mar 2004 00:30:50 -0800, (m4nd4li4)
wrote:

Hello,

Many thanks for the reply. Unfortunately there is a but!! After all
256 columns are filled on the first sheet, it does adds lots and lots
of BLANK sheets, that the number of sheets it adds is equal to the
number of text files in the directory. I wanted the second sheet to be
filled, to 256 columns, with the contents of the text files. Once all
256 columns are filled, I would like to do the same for the third
sheet, etc, etc...... Any suggestions???

Regards,

Bharesh
The code needs a tweak,
after creating a new sheet col is not reset so for 257, 258 etc
a new sheet is being added.

Change this bit of code
If col < 256 Then
col = col + 1
Else
ThisWorkbook.Sheets.Add Befo=Worksheets(1)
End If

to this
If col < 256 Then
col = col + 1
Else
ThisWorkbook.Sheets.Add Befo=Worksheets(1)
col = 1 ' reset count for next sheet
End If


Steve

Hi Steve,

Many thanks for the reply. But again it did not go to plan. I made the
changes as you said. But this time a second sheet is added but is
blank. What happens is that after the initial 256 columns are filled,
it begins at column 1 of the FIRST sheet, instead of the second sheet.
Now I am completely lost. It was obvious(!!!) you had to reset col
back to 1. But...???

Any other suggestions? I will not be beaten by this macro!!!

Regards,

Bharesh


(Steve Walton) wrote in message ...
On 4 Mar 2004 00:30:50 -0800, (m4nd4li4)
wrote:

Hello,

Many thanks for the reply. Unfortunately there is a but!! After all
256 columns are filled on the first sheet, it does adds lots and lots
of BLANK sheets, that the number of sheets it adds is equal to the
number of text files in the directory. I wanted the second sheet to be
filled, to 256 columns, with the contents of the text files. Once all
256 columns are filled, I would like to do the same for the third
sheet, etc, etc...... Any suggestions???

Regards,

Bharesh
The code needs a tweak,
after creating a new sheet col is not reset so for 257, 258 etc
a new sheet is being added.

Change this bit of code
If col < 256 Then
col = col + 1
Else
ThisWorkbook.Sheets.Add Befo=Worksheets(1)
End If

to this
If col < 256 Then
col = col + 1
Else
ThisWorkbook.Sheets.Add Befo=Worksheets(1)
col = 1 ' reset count for next sheet
End If


Steve

Sub Getmhl()
Dim wkbk As Workbook
Dim shDest As Worksheet
Dim col As Long
Dim i As Long
Dim rng As Range
Dim rng1 As Range
Dim rng2 As Range

Set shDest = ThisWorkbook.ActiveSheet
shDest.UsedRange.ClearContents
col = 1
With Application.FileSearch
NewSearch
LookIn = "C:\Documents and Settings\My Documents"
SearchSubFolders = False
FileName = "*.mhl"
FileType = msoFileTypeAllFiles

If .Execute() 0 Then
For i = 1 To .FoundFiles.Count

Workbooks.OpenText _
FileName:=.FoundFiles(i) ' _
' 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
Set wkbk = ActiveWorkbook
With wkbk.Worksheets(1)
Set rng = .Range(.Cells(1, 1), _
Cells(Rows.Count, 1).End(xlUp))
End With
rng.Copy Destination:=shDest.Cells(2, col)
shDest.Cells(1, col) = wkbk.Name
Set rng1 = shDest.Cells(Rows.Count, col).End(xlUp)(2)
Set rng2 = shDest.Range(shDest.Cells(2, col), rng1(0))
rng1.Formula = "=Average(" & rng2.Address & ")"
rng1(2).Formula = "=Stdev(" & rng2.Address & ")"
rng1(3).Formula = "=Count(" & rng2.Address & ")"
wkbk.Close SaveChanges:=False
If col < 256 Then
col = col + 1
Else
set shDest = ThisWorkbook.Sheets.Add Befo=Worksheets(1)
col = 1
End If
Next i
Else
MsgBox "There were no files found."
End If
End With
End Sub

--
Regards,
Tom Ogilvy


"m4nd4li4" wrote in message
om...
Hi Steve,

Many thanks for the reply. But again it did not go to plan. I made the
changes as you said. But this time a second sheet is added but is
blank. What happens is that after the initial 256 columns are filled,
it begins at column 1 of the FIRST sheet, instead of the second sheet.
Now I am completely lost. It was obvious(!!!) you had to reset col
back to 1. But...???

Any other suggestions? I will not be beaten by this macro!!!

Regards,

Bharesh


(Steve Walton) wrote in message
...
On 4 Mar 2004 00:30:50 -0800, (m4nd4li4)
wrote:

Hello,

Many thanks for the reply. Unfortunately there is a but!! After all
256 columns are filled on the first sheet, it does adds lots and lots
of BLANK sheets, that the number of sheets it adds is equal to the
number of text files in the directory. I wanted the second sheet to be
filled, to 256 columns, with the contents of the text files. Once all
256 columns are filled, I would like to do the same for the third
sheet, etc, etc...... Any suggestions???

Regards,

Bharesh
The code needs a tweak,
after creating a new sheet col is not reset so for 257, 258 etc
a new sheet is being added.

Change this bit of code
If col < 256 Then
col = col + 1
Else
ThisWorkbook.Sheets.Add Befo=Worksheets(1)
End If

to this
If col < 256 Then
col = col + 1
Else
ThisWorkbook.Sheets.Add Befo=Worksheets(1)
col = 1 ' reset count for next sheet
End If


Steve