Add new Worksheet after filling first 256 columns

  • Thread starter Thread starter m4nd4li4
  • Start date Start date
M

m4nd4li4

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 Before:=Worksheets(1)
End If
Next i
Else
MsgBox "There were no files found."
End If
End With
End Su
 
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
 
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
Click to expand...
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 Before:=Worksheets(1)
End If

to this
If col < 256 Then
col = col + 1
Else
ThisWorkbook.Sheets.Add Before:=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
 
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 Before:=Worksheets(1)
col = 1
End If
Next i
Else
MsgBox "There were no files found."
End If
End With
End Sub
 
Hi Tom,

Many thanks for helping out. But now I get a Compile Error:Syntax
Error at this line of code..

Set shDest = ThisWorkbook.Sheets.Add After := Worksheets(1)

I cannot understand why. I'm using Excel2003 with WinXP Pro. I will
eventually use this code on another computer with Excel97 and Win2000.
Could it be due to different Excel version I'm using?

Regards,

Bharesh
 
Hi,

Ignore my previous post. I got it working by changing this..

set shDest = ThisWorkbook.Sheets.Add Before:=Worksheets(1)

to this..

set shDest = ThisWorkbook.Sheets.Add (Before:=Worksheets(1))

And now it is working prefectly.

Many thanks to all who replied. My knowledge of VBA is now gettin
bigger!!!

Regards,

Bhares
 
That is the correction you need to make. I tested that aspect when I wrote
it, but I guess I forgot to add the parentheses when I posted - sorry about
that.
 
Back
Top