Excel 2010 running VBA code composed on Excel 2003 very slowly...

[scopemonkey]

Mr. Excel Community -

First off, let it be known that I'm not the original author of the 10-year old code (below), but merely maintain it.

After searching related threads on this site, attempts to incorporate some of the advice given were all unsuccessful at speeding up a multiple minute long subroutine that was once executed in 10 seconds.

The subroutine aspires to create a TREND tab for a given group name by iteratively -
(A) copying sequential build months on the SEARCH tab (for that group name's SEARCH tab), (B) finding and copying data for that build month and "age" MIS in the TIS tab (in the same group name's TIS tab) and then
(C) sequentially pasting data copied from the TIS tab as results into the created TREND tab (for the same group name).

I believe the problem exists with the scatter-shot command:

For Each rw In Worksheets(searchSheetName).Rows​

But, hopefully, the esteemed Mr. Excel community can advise after seeing the code (below):

============================
Sub Trend2()

'Index to write data in Trend Sheet
Dim rowIndex As Integer

'Final Table Information
Dim buildMonth As String
Dim modelYear As String
Dim vehicleCount As Long
Dim repairCount As Integer
Dim twoMIS As String
Dim sixMIS As String
Dim twelveMIS As String
Dim eighteenMIS As String
'Dim eighteenMIS As String
'Dim twelveMIS As String
Dim twoCPU As String
Dim sixCPU As String
Dim twelveCPU As String
Dim eighteenCPU As String
'Dim eighteenCPU As String
'Dim twelveMIS As String
'Used to create name strings - two entries
Dim sheetNameArray(2) As String
'Sheet Name Variables
Dim trendSheetName As String
Dim searchSheetName As String
Dim tisSheetName As String
'Search Sheet indexes
buildMonthSearchIndex = 1 'Column A
modelYearSearchIndex = 2 'Column B
'TIS Sheet indexes
buildMonthTISIndex = 2 'Column B
TIS_TISIndex = 3 'Column C
IPTV_TISIndex = 4 'Column D
vehRepairTISIndex = 5 'Column E
vehBuiltTISIndex = 6 'Column F
CPU_Index = 8 'Column H
modelYearTISIndex = 10 'Column J
'Trend Sheet Indexes
buildMonthTrendIndex = 0 'Column A
vehicleCountTrendIndex = 1 'Column B
repairCountTrendIndex = 2 'Column C
IPTVTrendIndex = 3 'Column D
twoMISTrendIndex = 4 'Column E
sixMISTrendIndex = 5 'Column F
twelveMISTrendIndex = 6 'Column G
eighteenMISTrendIndex = 7 'Column H
twoCPUTrendIndex = 8 'Column I
sixCPUTrendIndex = 9 'Column J
twelveCPUTrendIndex = 10 'Column K
eighteenCPUTrendIndex = 11 'Column L

'Get Name from User through Input box
'Place in first entry of the Array
sheetNameArray(0) = Application.InputBox("Program Name")

'Create Trend sheet name string
'Place "Trend" into second entry of Array
sheetNameArray(1) = "Trend"
'Join two entries together
trendSheetName = Join(sheetNameArray)
'Create Search Text sheet name string
'Place "Search" into second entry of Array
sheetNameArray(1) = "Search"

'Join two entries together
searchSheetName = Join(sheetNameArray)
'Create TIS sheet name string
'Place "TIS" into second entry of Array
sheetNameArray(1) = "TIS"
'Join two entries together
tisSheetName = Join(sheetNameArray)

'Add New Sheet for Trend Table, use Trend Sheet Name created above
Sheets.Add
ActiveSheet.Name = trendSheetName

'Add Table Titles to Trend Sheet
Range("A1").Select

rowIndex = 0 'Row 1

ActiveCell.Offset(rowIndex, buildMonthTrendIndex).Value = "Build Month"
ActiveCell.Offset(rowIndex, vehicleCountTrendIndex).Value = "Vehicles"
ActiveCell.Offset(rowIndex, repairCountTrendIndex).Value = "Repairs"
ActiveCell.Offset(rowIndex, IPTVTrendIndex).Value = "IPTV"
ActiveCell.Offset(rowIndex, twoMISTrendIndex).Value = "2 MIS"
ActiveCell.Offset(rowIndex, sixMISTrendIndex).Value = "6 MIS"
ActiveCell.Offset(rowIndex, twelveMISTrendIndex).Value = "12 MIS"
ActiveCell.Offset(rowIndex, eighteenMISTrendIndex).Value = "18 MIS"
ActiveCell.Offset(rowIndex, twoCPUTrendIndex).Value = "2 MIS_CPU"
ActiveCell.Offset(rowIndex, sixCPUTrendIndex).Value = "6 MIS_CPU"
ActiveCell.Offset(rowIndex, twelveCPUTrendIndex).Value = "12 MIS_CPU"
ActiveCell.Offset(rowIndex, eighteenCPUTrendIndex).Value = "18 MIS_CPU"
'Search based on build months in Search Sheet

For Each rw In Worksheets(searchSheetName).Rows

'Look for non-blank cells in build month column of Search Sheet
If rw.Cells(1, buildMonthSearchIndex).Value <> "" Then

'Store Build Month and model year from Search Sheet
buildMonth = rw.Cells(1, buildMonthSearchIndex).Value
modelYear = rw.Cells(1, modelYearSearchIndex).Value

'Initialize other table information
vehicleCount = 0
repairCount = 0
twoMIS = ""
sixMIS = ""
twelveMIS = ""
eighteenMIS = ""
twoMIS_CPU = ""
sixMIS_CPU = ""
twelveMIS_CPU = ""
eighteenMIS_CPU = ""

'Store row Index to allow updating of table later
rowIndex = rw.Row

'Search through each row of TIS Sheet
For Each rw2 In Worksheets(tisSheetName).Rows
'Find Build Month
If rw2.Cells(1, buildMonthTISIndex).Value = buildMonth Then
'Find Model Year
If rw2.Cells(1, modelYearTISIndex).Value = modelYear Then

'Find when TIS is zero, store number of vehicles built
If rw2.Cells(1, TIS_TISIndex).Value = 0 Then
vehicleCount = rw2.Cells(1, vehBuiltTISIndex).Value
End If

'Find when TIS is TWO, store IPTV (R/1000), CPU
If rw2.Cells(1, TIS_TISIndex).Value = 2 Then
twoMIS = rw2.Cells(1, IPTV_TISIndex).Value
twoCPU = rw2.Cells(1, CPU_Index).Value
End If

'Find when TIS is SIX, store IPTV (R/1000)
If rw2.Cells(1, TIS_TISIndex).Value = 6 Then
sixMIS = rw2.Cells(1, IPTV_TISIndex).Value
sixCPU = rw2.Cells(1, CPU_Index).Value
End If
'2_, 6MIS_CPU added 9-11-2007 (by K. Smith)

'Find when TIS is TWELVE, store IPTV (R/1000)
If rw2.Cells(1, TIS_TISIndex).Value = 12 Then
twelveMIS = rw2.Cells(1, IPTV_TISIndex).Value
twelveCPU = rw2.Cells(1, CPU_Index).Value
End If
'12, 18MIS_IPTV & CPU added 8-26-2010 (by K. Smith)

'Find when TIS is EIGHTEEN, store IPTV (R/1000)
If rw2.Cells(1, TIS_TISIndex).Value = 18 Then
eighteenMIS = rw2.Cells(1, IPTV_TISIndex).Value
eighteenCPU = rw2.Cells(1, CPU_Index).Value
End If
'12, 18MIS_IPTV & CPU added 8-26-2010 (by K. Smith)

'Get number of repairs at max TIS
'Keep storing everytime, max TIS is at the bottom
repairCount = rw2.Cells(1, vehRepairTISIndex).Value

End If ' Model Year
End If ' Build month
Next rw2 'TIS Sheet row

'Dump Data into Trend Sheet
Worksheets(trendSheetName).Activate
Range("A1").Select
ActiveCell.Offset(rowIndex, buildMonthTrendIndex).Value = buildMonth
ActiveCell.Offset(rowIndex, vehicleCountTrendIndex).Value = vehicleCount
ActiveCell.Offset(rowIndex, repairCountTrendIndex).Value = repairCount
ActiveCell.Offset(rowIndex, IPTVTrendIndex).FormulaR1C1 = "=RC[-1]/RC[-2]*1000"
ActiveCell.Offset(rowIndex, twoMISTrendIndex).Value = twoMIS
ActiveCell.Offset(rowIndex, sixMISTrendIndex).Value = sixMIS
ActiveCell.Offset(rowIndex, twelveMISTrendIndex).Value = twelveMIS
ActiveCell.Offset(rowIndex, eighteenMISTrendIndex).Value = eighteenMIS
ActiveCell.Offset(rowIndex, twoCPUTrendIndex).Value = twoCPU
ActiveCell.Offset(rowIndex, sixCPUTrendIndex).Value = sixCPU
ActiveCell.Offset(rowIndex, twelveCPUTrendIndex).Value = twelveCPU
ActiveCell.Offset(rowIndex, eighteenCPUTrendIndex).Value = eighteenCPU

'Format IPTV (R/1000) column - 2 decimal places
Columns("D:D").Select
Selection.NumberFormat = "0.00"

End If 'Not Blank
Next rw 'Search Sheet Row
End Sub

============================
Many thanks for your suggestions! Kevin Smith

 

[mole999]

Sub Trend2()
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

'Your Code

With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub

could do the trick

 

[scopemonkey]

mole999 - thanks for your quick response, but the code lengthened the run time. The only difference (other than the longer time) was that the TREND chart was not created and populated in real time like it had been before. It just shows up after 3 minutes of Excel in "no response" mode.

I appreciate your input.

Kevin

 

[mole999]

looking at the last lines this might work, I can't test it though

    With Worksheets(trendsheetname).Range("A1")
        .Offset(rowIndex, buildMonthTrendIndex).Value = buildMonth
        .Offset(rowIndex, vehicleCountTrendIndex).Value = vehicleCount
        .Offset(rowIndex, repairCountTrendIndex).Value = repairCount
        .Offset(rowIndex, IPTVTrendIndex).FormulaR1C1 = "=RC[-1]/RC[-2]*1000"
        .Offset(rowIndex, twoMISTrendIndex).Value = twoMIS
        .Offset(rowIndex, sixMISTrendIndex).Value = sixMIS
        .Offset(rowIndex, twelveMISTrendIndex).Value = twelveMIS
        .Offset(rowIndex, eighteenMISTrendIndex).Value = eighteenMIS
        .Offset(rowIndex, twoCPUTrendIndex).Value = twoCPU
        .Offset(rowIndex, sixCPUTrendIndex).Value = sixCPU
        .Offset(rowIndex, twelveCPUTrendIndex).Value = twelveCPU
        .Offset(rowIndex, eighteenCPUTrendIndex).Value = eighteenCPU

    'Format IPTV (R/1000) column - 2 decimal places
        .Columns("D:D").NumberFormat = "0.00"
    End With

though i am wondering if that could just be a straight paste of values once worked up from the earlier run

 

[scopemonkey]

Commenting out the line:
.Columns("D:D").NumberFormat = "0.00"

Had no effect. Thanks, though.
Still searching...

 

[mole999]

sometimes i time the events

Dim A
Dim B

then A = Now()
at the begining of the suspect section,
as its about to end i use
B = Now()

then i use

sheets("sheet1").range("A1") = B-A

adjust to suit and see which module is taking so long

maybe add a single select like this

With Worksheets(trendsheetname).Range("A1")
.select
.Offset(rowIndex, buildMonthTrendIndex).Value = buildMonth

 

[MARK858]

Not at home to post but is your line you think is the problem not looking at 1 million+ rows rather thsn the 65 thousand you had in the 2003 version.

 

[scopemonkey]

"Not at home to post but is your line you think is the problem not looking at 1 million+ rows rather thsn the 65 thousand you had in the 2003 version."

Yes. There's got to be an easy way to limit the searching to only the rows needed. Thanks all!

 

[MARK858]

There is. I'll post something when I get in tonight if nobody else has before then.

 

[MARK858]

Try changing

For Each rw In Worksheets(searchSheetName).Rows

to

For Each rw In Worksheets(searchSheetName).Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row

and see if it improves it and do the same with rw2 (please note the code is untested)