My simple macro causes my excel to freeze up

[ripkin900]

Ok guys, I am a newbie, made a simple macro, it works ok on my laptop home, its a little slow...my laptop which has windows 7, but at my work it just freezes up whenever i click the button to run macro(I have it assigned toa button)...its one of two macros in my spreadsheet....
We only have excel 2003 at work and I built it home on excel 2010 and saved it as a 2003 workbook....I do not know if this matters or not but just some info...
any thoughts??????

here is code:

[VBA]Sub importMerlin()


With Application
.DisplayAlerts = False
.ScreenUpdating = False
End With


Sheets("Merlin Dispatch").Select
Columns("A:M").Select
Selection.Clear


Range("A1").Select 'paste the text data here

Dim DestBook As Workbook, Sourcebook As Workbook
Dim DestCell As Range
Dim RetVal As Boolean

Set DestBook = ActiveWorkbook
Set DestCell = ActiveCell

'set up list of file types first
MyFilter = "Text Files (*.txt),*.txt," & _
"Lotus Files (*.prn), *.prn," & _
"Comma Separated Files (*.csv),*.csv," & _
"ASCII Files (*.asc),*.asc," & _
"Excel Files (*.xls),*.xls," & _
"All Files (*.*),*.*"

'Display *.txt by default: this is number 1 on the above list
FilterIndex = 6

MsgBox "Make sure the MERLIN report has ALL COLUMNS included, and you have to import MERLIN first"

'Set the dialog box caption
Title = "Select the Merlin Dispatch Report Report File to Import..."

'now get the file name
Filename = Application.GetOpenFilename(MyFilter, FilterIndex, Title)

'Exit if the Dialog Box is cancelled

If Filename = False Then
MsgBox "Hey,You didn't select a file!..."
Sheets("Macros").Select
Exit Sub
End If



Workbooks.Open Filename:=Filename


Range(Range("A1"), Range("A1").SpecialCells(xlLastCell)).Copy

Set Sourcebook = ActiveWorkbook
DestBook.Activate
DestCell.PasteSpecial Paste:=xlValues





Columns("C:C").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("B:B").Select
Selection.TextToColumns Destination:=Range("B1"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(7, 1)), TrailingMinusNumbers:=True
Range("B1").Select
ActiveCell.FormulaR1C1 = "Job Name"
Columns("C:C").Select
Selection.Delete Shift:=xlToLeft




Cells.Select
Cells.EntireColumn.AutoFit

Range("a1").Select


Sourcebook.Close False

End Sub[/VBA]

[NashProjects]

Hi Ripkin,

Is there any particular line that it freezes on?
If you go to your VBE and step through it using F8 that should allow you to identify easily the problem line...

Then i can help you alot easier!

Thanks

[santhoshkv]

Hi ripkin900,
the code works fine with a simple data. if u can explaine more on the input file, or share us with a sample file it will be good for us to test run it and provide a solution.

[Paul_Hossler]

Comment these out and see if there's an error you're not seeing


[VBA]
With Application
.DisplayAlerts = False
.ScreenUpdating = False
End With
[/VBA]

Paul

[mdmackillop]

Always use Option Explicit
Try to avoid Selecting.
I've "tidied" your code (no guarantee it will fix the hanging), and I may have made some wrong assumptions. Stepping though it should show any problems.
[VBA]Option Explicit

Sub importMerlin()
Dim Sourcebook As Workbook
Dim DestSheet As Worksheet
Dim DestCell As Range
Dim RetVal As Boolean
Dim MyFilter As String
Dim FilterIndex As Long
Dim Title As String
Dim FileName As String

With Application
.DisplayAlerts = False
.ScreenUpdating = False
End With

Set DestSheet = Sheets("Merlin Dispatch")
Set DestCell = DestSheet.Range("A1")

DestSheet.Columns("A:M").Clear

'set up list of file types first
MyFilter = "Text Files (*.txt),*.txt," & _
"Lotus Files (*.prn), *.prn," & _
"Comma Separated Files (*.csv),*.csv," & _
"ASCII Files (*.asc),*.asc," & _
"Excel Files (*.xls),*.xls," & _
"All Files (*.*),*.*"

'Display *.txt by default: this is number 1 on the above list
FilterIndex = 6

MsgBox "Make sure the MERLIN report has ALL COLUMNS included, and you have to import MERLIN first"

'Set the dialog box caption
Title = "Select the Merlin Dispatch Report Report File to Import..."

'now get the file name
FileName = Application.GetOpenFilename(MyFilter, FilterIndex, Title)

'Exit if the Dialog Box is cancelled

If FileName = False Then
MsgBox "Hey,You didn't select a file!..."
Sheets("Macros").Select
Exit Sub
End If

Set Sourcebook = Workbooks.Open(FileName)

'You should define the sheet name to be copied
With Sourcebook.Sheets(1)
Range(.Range("A1"), .Range("A1").SpecialCells(xlLastCell)).Copy
End With

DestCell.PasteSpecial Paste:=xlValues
Sourcebook.Close False

With DestSheet
.Columns("C:C").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
.Columns("B:B").TextToColumns Destination:=.Range("B1"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(7, 1)), TrailingMinusNumbers:=True
.Range("B1") = "Job Name"
.Columns("C:C").Delete
.Cells.EntireColumn.AutoFit
End With
End Sub[/VBA]