Code works but is slow except when....

[dexterslabmi]

Hello friends,

My code works but it is slow except when if I click on another
application (ie Internet Explorer) then it speeds up to the expected
performance. Any thoughts...


Sub ImportDash()

Dim MyFile, cell, m, n, bb, zs, zt As Variant
Dim mybook As Workbook
Dim i As Long
Dim Sh As Worksheet
Dim DexArray(1 To 8)
Dim RangeArray(1 To 8)

'Load all of the impacted workbooks into DexArray
DexArray(1) = "CNC-IBWC"
DexArray(2) = "CNC-SALES"
DexArray(3) = "CNC-HFC"
DexArray(4) = "MAK-SALES"
DexArray(5) = "MAK-HFC"
DexArray(6) = "MOP-IBWC"
DexArray(7) = "MOP-RQ"
DexArray(8) = "MOP CS Team"

'Load all of the impacted Ranges into RangeArray
RangeArray(1) = "a104:af104"
RangeArray(2) = "a118:ab118"
RangeArray(3) = "a125:q125"
RangeArray(4) = "a132:ac132"
RangeArray(5) = "a137:n137"
RangeArray(6) = "a146:af146"
RangeArray(7) = "a153:z153"
RangeArray(8) = "a158:l158"

'Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'Save workbook name for quick reference
Set zs = ThisWorkbook

' Ask the user for the file name to open.
MyFile = Application.GetOpenFilename(filefilter:="Excel
Files(*.xls),*.xls")
If MyFile = False Then
MsgBox "You didn't select correct file"
Exit Sub
End If

' Open the Text file with the OpenText method and parses data.
Workbooks.Open Filename:=MyFile, Origin:=xlWindows, ReadOnly:=True,
UpdateLinks:=False
zt = ActiveWorkbook.Name


'Again save imported workbook name for quick reference
Set mybook = ActiveWorkbook

'Prepare to loop thur arrays
For i = 1 To 8
zs.Sheets("main").Activate
For Each cell In Range(RangeArray(i))
'Find column location for data
If cell <> "" Then
m = cell.Value
n = cell.Column

mybook.Sheets(DexArray(i)).Activate
'Indentify data range using bb,aa strings and copy the
data over for imported sheet
bb = Cells.Find(what:="*", After:=[A1],
SearchDirection:=xlPrevious).Row
Range(Cells(7, m), Cells(bb, m)).Select
Selection.Copy
zs.Sheets(DexArray(i)).Activate
Cells(7, n).Select
Selection.PasteSpecial
Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False


zs.Sheets("main").Activate
End If
Next cell


Next i

end sub

Thanks in advance.... Dex

 

[PCLIVE]

I noticed you have the following line in your code that is remmed out.
'Application.ScreenUpdating = False

Add to the beginning of your code:
Application.ScreenUpdating = False

Add to the end of your code:
Application.ScreenUpdating = True

HTH,
Paul

 

[dexterslabmi]

Thanks but I tried that already, does not help .... Rimmed in out to
see if I could uncover the issue.

I noticed you have the following line in your code that is remmed out.
'Application.ScreenUpdating = False

Add to the beginning of your code:
Application.ScreenUpdating = False

Add to the end of your code:
Application.ScreenUpdating = True

HTH,
Paul

Hello friends,

My code works but it is slow except when if I click on another
application (ie Internet Explorer) then it speeds up to the expected
performance. Any thoughts...


Sub ImportDash()

Dim MyFile, cell, m, n, bb, zs, zt As Variant
Dim mybook As Workbook
Dim i As Long
Dim Sh As Worksheet
Dim DexArray(1 To 8)
Dim RangeArray(1 To 8)

'Load all of the impacted workbooks into DexArray
DexArray(1) = "CNC-IBWC"
DexArray(2) = "CNC-SALES"
DexArray(3) = "CNC-HFC"
DexArray(4) = "MAK-SALES"
DexArray(5) = "MAK-HFC"
DexArray(6) = "MOP-IBWC"
DexArray(7) = "MOP-RQ"
DexArray(8) = "MOP CS Team"

'Load all of the impacted Ranges into RangeArray
RangeArray(1) = "a104:af104"
RangeArray(2) = "a118:ab118"
RangeArray(3) = "a125:q125"
RangeArray(4) = "a132:ac132"
RangeArray(5) = "a137:n137"
RangeArray(6) = "a146:af146"
RangeArray(7) = "a153:z153"
RangeArray(8) = "a158:l158"

'Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'Save workbook name for quick reference
Set zs = ThisWorkbook

' Ask the user for the file name to open.
MyFile = Application.GetOpenFilename(filefilter:="Excel
Files(*.xls),*.xls")
If MyFile = False Then
MsgBox "You didn't select correct file"
Exit Sub
End If

' Open the Text file with the OpenText method and parses data.
Workbooks.Open Filename:=MyFile, Origin:=xlWindows, ReadOnly:=True,
UpdateLinks:=False
zt = ActiveWorkbook.Name


'Again save imported workbook name for quick reference
Set mybook = ActiveWorkbook

'Prepare to loop thur arrays
For i = 1 To 8
zs.Sheets("main").Activate
For Each cell In Range(RangeArray(i))
'Find column location for data
If cell <> "" Then
m = cell.Value
n = cell.Column

mybook.Sheets(DexArray(i)).Activate
'Indentify data range using bb,aa strings and copy the
data over for imported sheet
bb = Cells.Find(what:="*", After:=[A1],
SearchDirection:=xlPrevious).Row
Range(Cells(7, m), Cells(bb, m)).Select
Selection.Copy
zs.Sheets(DexArray(i)).Activate
Cells(7, n).Select
Selection.PasteSpecial
Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False


zs.Sheets("main").Activate
End If
Next cell


Next i

end sub

Thanks in advance.... Dex

 

[Kim Greenlee]

Dex,

A while back I had to look at performance issues in a huge Excel macro. I
stepped through the macro line by line to get a "feel" for where the slow
code was. I found the problems were in the copy/paste sections.

I suggest you do the same. Step through your code and see where the delays
are. That should give you some hints as to what is really going on. If it
is a copy/paste problem, I wrote up my approach here:
http://krgreenlee.blogspot.com/2006/01/software-workbook-to-workbook-copy.html

Good luck,

Kim Greenlee

 

[NickHK]

If you can drop all the .Selects it would help.

NickHK