Hi...the code crashes on...

Sub FileNamer() - highlighted in yellow

and

Do Until FileName$ = "" - FileNames$ is highlighted in grey

Error message says...

Type declration character does not match the correct data type.

Any thoughts...

Thanks so far.

Gordon...

"Kaak" wrote:


Maybe try this

Sub FileNamer()

Dim a, FilePath, FileName, DestPath As String
Dim wbActiveWorkbook As Workbook
Dim aStart As Integer

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

'EDIT TO MATCH PATH THAT CONTAINS YOUR FILES
FilePath = "C:\Desktop\Raw1\"

'EDIT TO MATCH FOLDER TO HOLD YOUR NEW FILES (MUST BE DIFFERENT
FROM Source Dir)
DestPath = "C:\tested\"
If Dir(DestPath, vbDirectory) = "" Then MkDir (DestPath$)

FileName = Dir(FilePath & "*.xls")
Do Until FileName$ = ""

Set wbActiveWorkbook = Workbooks.Open(FilePath & FileName, 0,
1)
a = CStr(wbActiveWorkbook.Sheets("Summary").Range("D3" ).Value)

For x = 1 To Len(a)
If IsNumeric(Mid(a, x, 1)) = True Then
aStart = x
a = Right(a, Len(a) - aStart + 1)
a = Trim(Left(a, InStr(a, " ")))
GoTo NumFound
End If
Next x

NumFound:

wbActiveWorkbook.SaveAs DestPath & a & ".xls"
wbActiveWorkbook.Close 0

FileName = Dir

Loop

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox "done"

End Sub


--
Kaak
------------------------------------------------------------------------
Kaak's Profile: http://www.excelforum.com/member.php...fo&userid=7513
View this thread: http://www.excelforum.com/showthread...hreadid=566599