to get the two characters before the period

A technique would be:

assume sStr holds the fully qualified file name produced by fileSearch
iloc = Instr(1,sStr,".",vbtextcompare)
dd = mid(sStr,iloc-2,2)


to demonstrate from the immediate window:

sStr = "myfileyyymm29.xls"
iloc = Instr(1,sStr,".",vbtextcompare)
? iloc
14
dd = mid(sStr,iloc-2,2)
? dd
29

So you would just put the results of the variable in a cell.

Adjust to fit your code.

--
Regards,
Tom Ogilvy


"Al" wrote in message
...
Thanks Tom
With a little tweaking I have it working. On my first run I found that a
daily file is missing. Is there a modification that I can make that would
put
dd from myfileyyymmdd.xls in an adjacent cell?
Thanks again!

"Tom Ogilvy" wrote:

Sub Summary()

Dim myCell As Range
Dim myBook as Workbook
Dim i as Long
Dim r as Range, r1 as Range

With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
End With

With Application.FileSearch
.NewSearch
'Copy or move this workbook to the folder with
'the files that you want to summarize
.LookIn = ThisWorkbook.Path
.FileType = msoFileTypeExcelWorkbooks
If .Execute() 0 Then
For i = 1 To .FoundFiles.Count
If .FoundFiles(i) < ThisWorkbook.FullName Then
if instr(1,.foundfiles(i),"A.xls",vbTextCompare) then
Set myBook = Workbooks.Open(.FoundFiles(i))
myBook.Worksheets("sheet1").Select
set r = MyBook.Worksheets("Sheet1").Range("BP18:BU18")
set r1 = ThisWorkbook.Worksheets(1). _
Range("B65536").End(xlUp)
if r1.Row = 1 then set r1 = r1.offset(1,0)
if not isempty(r1) then set r1 = r1.offset(1,0)
r.copy destination:=r1
MyBook.Close SaveChanges:=False
End if ' Instr
End If ' not thisworkbook
Next i
End If
End With

With Application
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
End With

ThisWorkbook.SaveAs Application.GetSaveAsFilename

End Sub

Untested, but this should be a start.

--
Regards,
Tom Ogilvy


"Al" wrote in message
...
Youre not being annoying Im being dyslexic :-) Got my columns and
rows
mixed
up
b2:g2
b3:g3
etc
Sorry!


"Tom Ogilvy" wrote:

Not trying to be annoying, but in Excel

B2:B7 and C2:C7 would look like this:

b2:b7 c2:c6
100 500
252 235
40 400
53 5212
5000 500
250 650


Two columns, not two rows. Is that what you mean?

--
Regards,
Tom Ogilvy


"Al" wrote in message
...
Sorry for the confusion. There are 2 files for each weekday M-F
(1
"A"
and 1
"P") and one file for Sat and Sun ("A" Only). I want to copy
BP18:BU18 On
each "A" file in the directory to a new book starting in b2:b7
(typo
not
b6)

Example:
Myfile20050601A.xls
BP18:BU18 100 252 40 53 5000 250

Myfile20050602A.xls
BP18:BU18 500 235 400 5212 500 650

In the new book
b2:b7 100 252 40 53 5000 250
c2:c6 500 235 400 5212 500 650

Hope this helps
Thanks!

"Tom Ogilvy" wrote:

How many files will be in ThisWorkbookPath. Just 3. the file
with
the
code, the A file and the P file.

If not, how do we know what date will be in the file name. Is
it
today's
date, yesterday's date, some other date.

What does "Sheet B2:B6" mean?

Do you want to copy all the 7 cells in BP18:BU18 to a new row in
the
summary
sheet?

--
Regards,
Tom Ogilvy



"Al" wrote in message
...
Hello

I am trying to modify existing code to accomplish the
following:
Copy
range
bp18:bu18 from sheet1 of a daily file and paste to a new
montyhly
summary
sheet B2:B6, with a new row for for each day. There are 2
files
created
each
day myfileyyyymmddA.xls and myfileyyyymmddP.xls. I would like
to
only
copy
from the "A" file. This is the code I have but it copies A
and P
and
is
pasting in Column A only.

Sub Summary()

Dim myCell As Range

With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
End With

With Application.FileSearch
.NewSearch
'Copy or move this workbook to the folder with
'the files that you want to summarize
.LookIn = ThisWorkbook.Path
.FileType = msoFileTypeExcelWorkbooks
If .Execute() 0 Then
Set Basebook = ThisWorkbook
For i = 1 To .FoundFiles.Count
If .FoundFiles(i) < ThisWorkbook.FullName Then
Set myBook = Workbooks.Open(.FoundFiles(i))
myBook.Worksheets("sheet1").Select
For Each myCell In _
Intersect(ActiveSheet.Range("BP18:BU18"),
ActiveSheet.UsedRange)
If myCell.Value < 0 Then
ThisWorkbook.Worksheets(1). _
Range("A65536").End(xlUp)(2).Value = _
myCell.Value
End If
Next myCell
myBook.Close
End If
Next i
End If
End With

With Application
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
End With

Basebook.SaveAs Application.GetSaveAsFilename

End Sub

Thanks!
Al