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

 

[MARK858]

Sorry should be an s at the end of that

For Each rw In Worksheets(searchSheetName).Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row[COLOR="#FF0000"]s[/COLOR]

I will ask other questions if it doesn't work as I must admit I don't like the look of the syntax but can't tell without testing.

 

[scopemonkey]

Thanks for the suggestion, MARK858, but after pasting pasting the code - executing that module resulted in only the headers being printed in the created "...TREND" file.

The goal of this inquiry is to reduce the time associated with the following loops:

For Each rw In Worksheets(searchSheetName).Rows

and

For Each rw2 In Worksheets(tisSheetName).Rows

Data in the "...SEARCH" tabs (upon which the criteria in the "...TIS" tab is searched, copied and then pasted in the "...TREND " tab) is comparatively small (<5% if the number of lines in the "...TIS" tabs). The number of rows copied and pasted into the "...TREND" tab (using data from the "...TIS" tab) is always one more than number of the lines in the "...SEARCH" tab because headers are printed in the "...TREND" tab.

Perhaps loops that include reference to rw and rw2 can be limited by the data ranges in the respective "...SEARCH" and "...TIS" tabs, respectively.

Thanks! Kevin

 

[MARK858]

Try

   Dim lr As Long

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

Then use it as

    For rw = 1 To lr
        If [COLOR="#FF0000"]Rows(rw)[/COLOR].Cells(1, buildMonthSearchIndex).Value <> "" Then

and

           For rw2 = 1 To lr
                If [COLOR="#FF0000"]Rows(rw2)[/COLOR].Cells(1, buildMonthTISIndex).Value = buildMonth Then

respectively. Obviously changing all the rw to Rows(rw) and rw2 to Rows(rw2)

 

[MARK858]

Obviously changing all the rw to Rows(rw) and rw2 to Rows(rw2)

except where it says Next rw and Next rw2