ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Discussion (Misc queries) (https://www.excelbanter.com/excel-discussion-misc-queries/)
-   -   Problem with macro (https://www.excelbanter.com/excel-discussion-misc-queries/163005-problem-macro.html)

Dave
Problem with macro
 
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

JLatham
Problem with macro
 
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

Dave
Problem with macro
 
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

JLatham
Problem with macro
 
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


All times are GMT +1. The time now is 10:44 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com