Problem with macro

D

Dave

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
 
J

JLatham

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).
 
D

Dave

using Excel 2003.

I'll try what you suggest

Thanks
Dave

JLatham said:
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 said:
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
Click to expand...
Click to expand...
 
J

JLatham

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

Dave said:
using Excel 2003.

I'll try what you suggest

Thanks
Dave

JLatham said:
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 said:
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
Click to expand...
Click to expand...
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Change a great number of words in word files, with a macro as short as possible. 5
Word macro that can call cells out of Excel for a find and replace 0
Making a macro only work on certain files 2
Help with Macro & Directory 1
Remove Identical words 0
Macro to Select text from a point given to a specific word 2
Creating Pivot Table with Macro using Multiple Sheets 0
VBA for Dependents shortcut menu 0

Top