Solved: Help speed up this code (2 FOR loops seem to be the problem)

[mae0429]

Hi all,

I took a look at the "optimizing your code" article and made some changes in the other parts of my code which have really helped: to get to this point it only takes 5 seconds now (which is about 20 seconds faster ). I'm stuck at these 2 FOR loops, which are slowing things down considerably (this piece of code takes me about 13 seconds, but is repeated 7 times with slight variations in the code each time. The number of columns is 105 (right now, could be more) and the number of rows is 1013 (which will definitely be more in the future).

[vba]'**********************************************
Dim Start As Double, Finish As Double
Start = Timer
'**********************************************
'Create individual product and root cause scope sheets by sorting raw data page
Worksheets("RAW CAPA DATA").Activate
ActiveSheet.Range("A1").Select
Selection.CurrentRegion.Select
Selection.Copy
Worksheets("ICDs").Select
ActiveSheet.Paste
For i = 1 To LastColumn
Select Case i
Case 1, 11, 12, 15, 16, 17, 18, 22, 28, 36, 37, 85
Columns(i).EntireColumn.AutoFit
Case Else
Columns(i).Hidden = True
End Select
Next i
For j = 2 To LastRow
Rows(j).RowHeight = 69.75
Next j
Range("CH2").Select
Selection.AutoFilter Field:=86, Criteria1:="ICD"
Range("A1:CG1").Select
With Selection
.HorizontalAlignment = xlCenter
.Merge
End With
ActiveCell.FormulaR1C1 = "RAW CAPA DATA - ICDs"
ActiveWindow.Zoom = 75
'**********************************************
Finish = Timer
MsgBox "Run time was " & Finish - Start
'**********************************************[/vba]

I can also take out the ".Select" followed by "Selection." pieces right?

Thanks for any help!

-Matt

[greymalkin]

For the copy/paste try this it may be a little faster:

[vba]
Selection.CurrentRegion.Select
Selection.Copy Destination:=Sheets("ICDs").Range("A1") 'Or whatever range you need to start pasting to
[/vba]

Neither of the 2 for loops are necessary:

FOR LOOP 1:

For selecting the Columns and autofitting/hiding this will take a little bit of upfront work but it will make things faster from then on:

1) Select all the columns you want to autofit and make them a name defined range (Insert - Name - Define). We'll call this defined range "autoFitRange". You could also hard code this in your code but it will be a lot of typing and is easier to just create the name defined range and call it.

2) Select all the columns you want to hide and make them a seperate name defined Range. We'll call it "hideRange"

Then instead of a loop you could just do this:

[vba]
Range("autoFitRange").Select
Selection.EntireColumn.AutoFit ' or Selection.Columns.AutoFit

Range("hideRange").Select
Selection.Columns.Hidden = True
[/vba]

If the ranges are going to change between iterations you could make multiple defined ranges and (autoFitRange_1, 2, etc) and still loop through the same code, just changing the 1,2,3, on the defined range, etc. With different sheets just change the sheetname with each iteration and use a string variable in the place of the actual sheet name.


FOR LOOP 2:

Do this instead:

[vba]
Rows("2:" & lastRow).RowHeight = 69.25
[/vba]

this will select all the rows and perform the height change on all of them at the same time.
Also, if you turn off screen updating this will increase the speed of your code as it's not having to display everything that's going on (not sure if you've already done this or not. If not it's simple to do:

At the start of your code use Application.ScreenUpdating = False
Then at the end set it back to True.

[mae0429]

Thanks for the one-liner: it cut off about 4 seconds. Is there anything I can do to the column-hiding loop? And yup, already got screen updating off.

[Bob Phillips]

Untested, but you can try this

[vba]
'**********************************************
Dim Start As Double, Finish As Double
Start = Timer
'**********************************************
'Create individual product and root cause scope sheets by sorting raw data page
With Worksheets("ICDs")

Worksheets("RAW CAPA DATA").Activate
ActiveSheet.Range("A1").CurrentRegion.Copy .Range("A1")
With .Columns(1).Resize(, LastRow)
.AUtofit
.Hidden = True
End With
.Columns("A").Hidden = False
.Columns("K:L").Hidden = False
.Columns("O:R").Hidden = False
.Columns("V:V").Hidden = False
.Columns("AB,AJ").Hidden = False
.Rows(j).Resize(LastRow).RowHeight = 69.75
.Range("CH2").AutoFilter Field:=86, Criteria1:="ICD"
With .Range("A1:CG1")
.HorizontalAlignment = xlCenter
.Merge
End With
.Range("A1").FormulaR1C1 = "RAW CAPA DATA - ICDs"
End With
ActiveWindow.Zoom = 75
'**********************************************
Finish = Timer
MsgBox "Run time was " & Finish - Start
'**********************************************
[/vba]

[mae0429]

First off: thanks to both of you for trying to help me out!

greymalkin: I haven't looked into it yet, but I'm going to have to hard code it if I use your suggestion (which seems like a good route to take) because this is going to be a monthly process and I'm not going to be the one doing it (and you can't always count on someone doing certain steps correctly...). Sounds good though, and worth looking into.

xld: Makes sense, but it didn't like two line from your code.
[VBA]
With Columns(1).Resize(, LastRow)
[/VBA]
and
[VBA]
.Columns("AB,AJ").Hidden = False
[/VBA]

I can split the columns line up into 2 lines, but it doesn't like the resize line at all...

I'll keep toying with it, but unless you have any further suggestions, I'll mark this as solved and get to work on hardcoding greymalkin's idea.

[mae0429]

Got the Resize to work, but I'm not getting an autofilter anymore AND it actually increased the time to run somehow...possibly from autofitting all the columns?

[mae0429]

Fixed it. Apparently, when I select the range, then autofilter it works. Marking as solved.