That's a lot of code.
Just some general tips. Drop the .selects.
Columns("G:G").Select
Selection.Style = "Comma"
Selection.ColumnWidth = 14.71
could become:
with columns("G:G")
.style = "Comma"
.columnwidth = 14.71
end with
if you're just changing the column width:
Columns("A:A").ColumnWidth = 11.43
==========
And when you're inserting a formula into a range, you can populate that whole
range in one fell swoop. Write your formula for the first cell in the range:
for i = 1 to Range("b65536").End(xlUp).Row
if i > 3 then
cells(I,"H").formula = "=...."
could become:
range("H3:H" & range("b65536").end(xlup).row).formula _
= "=..."
=============
This kind of looping:
Select Case Cells(i, "b")
Case "10151": Cells(i, "c") = "Phoenix Sealing Department"
Case "10161": Cells(i, "c") = "Phoenix Asphalt Department"
Case "10171": Cells(i, "c") = "Phoenix Flexseal Department"
might be better with finds. Here's a skinnied down version as an example:
Dim myLookFors As Variant
Dim myReplacements As Variant
Dim iCtr As Long
Dim FoundCell As Range
Dim FirstAddress As String
myLookFors = Array("10151", "10161", "10171")
myReplacements = Array("Phoenix Sealing Department", _
"Phoenix Asphalt Department", _
"Phoenix FlexSeal Department")
For iCtr = LBound(myLookFors) To UBound(myLookFors)
With Range("b:b")
Set FoundCell = .Cells.Find(What:=myLookFors(iCtr), _
MatchCase:=False, after:=.Cells(.Cells.Count), _
LookIn:=xlValues, LookAt:=xlWhole, _
searchorder:=xlByRows, searchdirection:=xlNext)
If FoundCell Is Nothing Then
'do nothing
Else
FirstAddress = FoundCell.Address
Do
FoundCell.Offset(0, 1).Value = myReplacements(iCtr)
Set FoundCell = .FindNext(FoundCell)
Loop While Not FoundCell Is Nothing _
And FoundCell.Address <> FirstAddress
End If
End With
Next iCtr
(This is pretty much a copy of the example from VBA's help.)
==========
Instead of looping through the worksheets to see if it exists, you could use a
function posted by Chip Pearson:
Function WorksheetExists(SheetName As String, _
Optional WhichBook As Workbook) As Boolean
'from Chip Pearson
Dim WB As Workbook
Set WB = IIf(WhichBook Is Nothing, ThisWorkbook, WhichBook)
On Error Resume Next
WorksheetExists = Len(WB.Worksheets(SheetName).Name) > 0
End Function
===========
But I gotta believe the biggest time improvement would be to consolidate your
deletion of rows.
Does your data allow you to combine these things?
If Cells(i, "b") = "Job" Then
lRow = i
ElseIf Cells(i, "a") = " Sun" Then
sRow = i
End If
If sRow > 0 And lRow > 0 Then
Rows(sRow & ":" & lRow).Delete
sRow = 0
lRow = 0
End If
I used just two in this example:
If Cells(i, "b") = "Job" _
or Cells(i, "a") = "Curr" then
lRow = i
ElseIf Cells(i, "a") = " Sun" _
or Cells(i, "a") = "Sunl" Then
sRow = i
End If
If sRow > 0 And lRow > 0 Then
Rows(sRow & ":" & lRow).Delete
sRow = 0
lRow = 0
End If
I would bet that most the time is spent looping through the rows multiple
times. If you could combine it into one loop, it might be a bit quicker.
=======
And with this stuff, maybe a straight replace would work ok.
Select Case Cells(i, "c")
Case "101 Totals:":
Cells(i, "c") = "Phoenix Totals:"
Rows(i & ":" & i).Select
Selection.Font.ColorIndex = 5
Then record a macro when you apply data|filter|autofilter (for contains totals
to that C column. Edit|goto|special|visible cells only. And then format those
visible rows all at one time.
===
and if you turn calculation to manual, it could help (and turn it back to what
it was when you're done.)
