With Excel 2007 there should not be any problem with the .FileSearch - on
potential problem ruled out.

"Dave" wrote:

using Excel 2003.

I'll try what you suggest

Thanks
Dave

"JLatham" wrote:

What version of Excel are you running?

The code appeared to run without error in my copy of Excel 2003.

I'd suggest that for a little while you comment out the
On Error GoTo ErrHandler
statement and then try to run and when you get the error, use the [Debug]
option to see which statement in the code is causing the problem, that will
give you (and us) a better clue of where to look for a problem.

If you're using Excel 2007, if memory serves me correctly, the .FileSearch
is not available (but I'm subject to RAM failure at the drop of a bit).

"Dave" wrote:

I have the following macro:

Code:

Sub Convert()

Dim lCount As Long
Dim wbResults As Workbook
Dim wbCodeBook As Workbook

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

On Error GoTo ErrHandler

Set wbCodeBook = ThisWorkbook


Set something = Application.FileDialog(msoFileDialogFolderPicker)

something.Show

somethingpath = CurDir()

With Application.FileSearch
.NewSearch

.LookIn = somethingpath
.FileType = msoFileTypeExcelWorkbooks


If .Execute 0 Then 'Workbooks in folder
For lCount = 1 To .FoundFiles.Count 'Loop through all.

Set wbResults = Workbooks.Open(.FoundFiles(lCount))

'' MACRO PASTED BELOW

Columns("A:A").Delete
Columns("C:C").Delete
Rows("1:7").Delete

Columns("B").Insert
Columns("B").Insert
Columns("B").Insert
Columns("B").Insert
Columns("B").Insert
Columns("B").Insert


Columns("A:A").TextToColumns Destination:=Range("A1"),
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True,
Tab:=False, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False,
FieldInfo _
:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True

LastRow = Cells(Rows.Count, "A").End(xlUp).Row

Columns("A").Delete

Columns("A").Insert

Range("A1").Formula = "=IF(D1<"""",D1,IF(C1<"""",C1,B1))"
Range("A1").Copy Destination:=Range("A2:A" & LastRow)

Columns("A:A").Insert

Columns("B:B").Copy

Columns("A:A").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False

Columns("B:H").Delete

wbResults.Close SaveChanges:=True

'' MACRO ABOVE


Next lCount

Else: MsgBox "No Files Found. Check Step 1?"
GoTo ExitHandler

End If
End With

On Error GoTo 0
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True

ExitHandler:
Application.ScreenUpdating = True
Exit Sub

ErrHandler:
MsgBox Err.Description
Resume ExitHandler

End Sub

The macro should run.

It should choose a folder containing a number of similar XLS files.

It should then run the macro within the pasted section on each of these XLS
files.

When I run it, the browse box comes up, but an error appears.

Can anyone help?

Dave