Make this code more efficient

[HWL]

I have a macro that works fine except this piece of it which dramatically slows down. The spread sheet it is applying to has about 3000 rows of data.

This piece of code is simply trying to format the sheet; set freeze panes, make font consistent, autofit rows/cols, and delete blank rows. Is there someone who could re-write it to dramatically increase the speed? THANKS

Application.StatusBar = "****Please Wait***** Formatting " & Sheets(1).Name
Sheets(1).Activate
Rows("2:2").Select
ActiveWindow.FreezePanes = True
Cells.Select
With Selection.Font
.Name = "Arial"
.Size = 12
Cells.EntireColumn.AutoFit
Cells.EntireRow.AutoFit
End With
'deletes blank rows
Dim LastRow1 As Long, i As Long
LastRow1 = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
For i = LastRow1 To 1 Step -1 'row 1 is the header row.
With Rows(i)
If Application.WorksheetFunction.CountBlank(.Cells) = .Cells.Count Then .EntireRow.Delete
End With
Next i
'end blank row code

 

[HWL]

Investigate whether this:

With .Cells.Font

targets only the usedrange of the sheet, or the full sheet.

What is the usedrange of that sheet, by the way?

Hmm, I picked up the usedrange code somewhere else, it is supposed to tell me the last populated row so that the loop only cycles to there instead of arbitrarily putting some high number like 50000, but maybe its not working either

 

[shg]

Sorry, that should be

With [COLOR=red]UsedRange[/COLOR].Cells.Font

 

[wigi]

Sorry, that should be

With [COLOR=red]UsedRange[/COLOR].Cells.Font

No,

With [COLOR=red].[/COLOR]UsedRange.Cells.Font