Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Discussion (Misc queries) > Problem with macro
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
  
Posts: 1,388
Default 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

Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
  
Posts: 3,365
Default 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

Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
  
Posts: 1,388
Default 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

Reply With QuoteReply With Quote
  #4   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
  
Posts: 3,365
Default 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

Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Linear Mode Linear Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
Problem in macro Micos3 Excel Discussion (Misc queries) 2 February 23rd 06 02:20 PM
Macro problem....... Alec H Excel Discussion (Misc queries) 4 February 15th 06 11:38 AM
Macro problem Frazer Excel Discussion (Misc queries) 3 August 18th 05 01:43 PM
Macro problem Jonah Excel Worksheet Functions 0 May 15th 05 09:13 PM
macro problem Kevin Excel Discussion (Misc queries) 1 December 14th 04 10:47 PM


All times are GMT +1. The time now is 10:27 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement