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

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


wrote in message
ups.com...
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

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


PCLIVE wrote:
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


wrote in message
ups.com...
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

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

NickHK

wrote in message
ups.com...
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