The below code works PREFECTLY on my Exccel 2003 - Windows PC

I took it out to a client's office this morning and we spent 2 hours
trying to get the Macro ExtractDataFromFiles() to run -- all without
success.
Our initial problem started with line 2 - where I needed to replace
Const.... with the area on the Mac HD... neither he or I knew exactly
How to do it... We might have fixed it because we 30 minutes later
noticed the code stopped on the line:
UserForm1.Show vbModeless << with the keyword vbmodeless highlite < so
I ''
Commented it out and things seemed to run a bit further,, but anyway it
ended
Up being a 2 hour fiasco, unfortunately, and I was so proud of what I
had
Done on my windows PC,, grrrrrr
Can anyone offer some help here - He has an uptodate Macintosh (sorry
don't
Know versions of it or his excel ver,,,
Thanks,

Option Explicit
Option Base 1

Sub ExtractDataFromFiles()
Const sPath = "C:\Documents and Settings\Jim May\My Documents\Boatwright
Stan\Projects\Lodging_Technology\Contracts\"
Dim sName As String
Dim wb As Workbook
Dim j As Integer
Dim n As Integer
Dim r(1 To 14) As Variant
ActiveSheet.Range("A6:N2000").ClearContents

Application.ScreenUpdating = False
Application.DisplayAlerts = False
sName = Dir(sPath & "PA*.xls")
j = 6 ' Data starts on Row 6
MsgBox "There are " & FileCount(sPath) & " Qualifying Files"
UserForm1.Show vbModeless
Do While sName < ""
Set wb = Workbooks.Open(sPath & sName)
With wb.Worksheets("Cost Analysis")
r(1) = .Range("J2").Value
r(2) = .Range("B4").Value
r(3) = .Range("B6").Value
r(4) = .Range("G4").Value
r(5) = Left(.Range("G6").Value, Len(.Range("G6")) - 2)
r(6) = Right(.Range("G6").Value, 2)
r(7) = .Range("J1").Value
r(8) = .Range("G51").Value
r(9) = .Range("G53").Value
r(10) = .Range("G54").Value
r(11) = .Range("G56").Value
r(12) = .Range("G57").Value
r(13) = .Range("G58").Value
r(14) = .Range("G59").Value
End With
wb.Close SaveChanges:=False
DoEvents
UserForm1.Repaint
With ThisWorkbook.ActiveSheet
For n = 1 To 14
..Cells(j, n).Value = r(n)
Next n
End With
j = j + 1
sName = Dir
Loop
Range("G3").Value = Now()
AutoFilterOn
UserForm1.Hide
Unload UserForm1
End Sub
Function FileCount(FolderName As String, _
Optional FileFilter As String = "PA*.xls", _
Optional FileTypes As Long = 1, _
Optional SubFolders As Boolean = False) As Long
With Application.FileSearch
.NewSearch
.LookIn = FolderName
.SearchSubFolders = SubFolders
.Filename = FileFilter
.MatchTextExactly = True
.FileType = FileTypes
.Execute
FileCount = .FoundFiles.Count
End With
End Function

Sub AutoFilterOn()
If Sheets("Main").AutoFilterMode = False Then
Range("A5:N5").AutoFilter
End If
End Sub

Jim,
Mac certainly have a different format for the drive and may be for the path,
your const sPath is not a valid location.
I'd be surprised if he had a "..\Documents and Settings\Jim May\My
Documents.." path anyway, as that is Windows structure.
I assume the Mac version has a macro recorder, so see what it gives you for
the required path .

NickHK

"Jim May" ???????:uo4Bg.106109$IZ2.3687@dukeread07...
The below code works PREFECTLY on my Exccel 2003 - Windows PC

I took it out to a client's office this morning and we spent 2 hours
trying to get the Macro ExtractDataFromFiles() to run -- all without
success.
Our initial problem started with line 2 - where I needed to replace
Const.... with the area on the Mac HD... neither he or I knew exactly
How to do it... We might have fixed it because we 30 minutes later noticed
the code stopped on the line:
UserForm1.Show vbModeless << with the keyword vbmodeless highlite < so I
''
Commented it out and things seemed to run a bit further,, but anyway it
ended
Up being a 2 hour fiasco, unfortunately, and I was so proud of what I had
Done on my windows PC,, grrrrrr
Can anyone offer some help here - He has an uptodate Macintosh (sorry
don't
Know versions of it or his excel ver,,,
Thanks,

Option Explicit
Option Base 1

Sub ExtractDataFromFiles()
Const sPath = "C:\Documents and Settings\Jim May\My Documents\Boatwright
Stan\Projects\Lodging_Technology\Contracts\"
Dim sName As String
Dim wb As Workbook
Dim j As Integer
Dim n As Integer
Dim r(1 To 14) As Variant
ActiveSheet.Range("A6:N2000").ClearContents

Application.ScreenUpdating = False
Application.DisplayAlerts = False
sName = Dir(sPath & "PA*.xls")
j = 6 ' Data starts on Row 6
MsgBox "There are " & FileCount(sPath) & " Qualifying Files"
UserForm1.Show vbModeless
Do While sName < ""
Set wb = Workbooks.Open(sPath & sName)
With wb.Worksheets("Cost Analysis")
r(1) = .Range("J2").Value
r(2) = .Range("B4").Value
r(3) = .Range("B6").Value
r(4) = .Range("G4").Value
r(5) = Left(.Range("G6").Value, Len(.Range("G6")) - 2)
r(6) = Right(.Range("G6").Value, 2)
r(7) = .Range("J1").Value
r(8) = .Range("G51").Value
r(9) = .Range("G53").Value
r(10) = .Range("G54").Value
r(11) = .Range("G56").Value
r(12) = .Range("G57").Value
r(13) = .Range("G58").Value
r(14) = .Range("G59").Value
End With
wb.Close SaveChanges:=False
DoEvents
UserForm1.Repaint
With ThisWorkbook.ActiveSheet
For n = 1 To 14
.Cells(j, n).Value = r(n)
Next n
End With
j = j + 1
sName = Dir
Loop
Range("G3").Value = Now()
AutoFilterOn
UserForm1.Hide
Unload UserForm1
End Sub
Function FileCount(FolderName As String, _
Optional FileFilter As String = "PA*.xls", _
Optional FileTypes As Long = 1, _
Optional SubFolders As Boolean = False) As Long
With Application.FileSearch
.NewSearch
.LookIn = FolderName
.SearchSubFolders = SubFolders
.Filename = FileFilter
.MatchTextExactly = True
.FileType = FileTypes
.Execute
FileCount = .FoundFiles.Count
End With
End Function

Sub AutoFilterOn()
If Sheets("Main").AutoFilterMode = False Then
Range("A5:N5").AutoFilter
End If
End Sub