Excel Locks up at end of Sub

[Hugenstein]

My Macro worked fine, then one day it started locking up excel right
before the end of the sub. I have to End task out. The macro saves
the file with a new filename at the beginning. If I open that file and
try to rerun the macro after the lock up, it works all the way through.
I'm thinking it's a memory overflow thing or something with the new file
not existing. I don't know.

The code is below. The macros reside in a seperate workbook than the
book being modified, the macros are initiated through the menu bar.

Thanks for looking, Ryan
==========================================================
Sub FactorFormatAfterBB()

'-->Turns Bloomberg arrays into values
Columns("E:H").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False

Application.DisplayAlerts = False
'-->Create filename to be saved as; then Save the file...
Range("Z1").Select
ActiveCell.FormulaR1C1 = _

"=CONCATENATE(""h:\dataclnp\factors\"",MONTH(TODAY()),DAY(TODAY()),YEAR(TODAY()),""bb.xls"")"
SaveLoc = Range("Z1")
ActiveWorkbook.SaveAs Filename:=SaveLoc, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Application.DisplayAlerts = True

Range("Z1").Select
Selection.ClearContents

' -->Formatting
Range("A2").Select
Selection.Sort Key1:=Range("F2"), Order1:=xlAscending,
Key2:=Range("A2") _
, Order2:=xlAscending, Header:=xlYes, OrderCustom:=1,
MatchCase:=False _
, Orientation:=xlTopToBottom

Range("I1").Select
ActiveCell.FormulaR1C1 = "CAMRA Factor Dt"
Columns("I:I").ColumnWidth = 15.57
Range("j1").Select
ActiveCell.FormulaR1C1 = "N/A Chk"
Range("k1").Select
ActiveCell.FormulaR1C1 = "Past Chk"
Range("C").Select
Selection.Delete Shift:=xlToLeft
Range("E8").Select
Range("A1").Select
Selection.AutoFilter

' Find range to Autofill
Range("A1").Select
If IsEmpty(Range("A5000")) = False Then
RowOffset = 4999
Range("A5000").Select
Else
If IsEmpty(Range("A4000")) = False Then
RowOffset = 3999
Range("A4000").Select
Else
If IsEmpty(Range("A2500")) = False Then
RowOffset = 2499
Range("A2500").Select
Else
RowOffset = 0
Range("A1").Select
End If
End If
End If

Do While IsEmpty(ActiveCell) = False
ActiveCell.Offset(R + 1, C).Select
RowOffset = RowOffset + 1
Loop

Columns("G:G").Select
Selection.NumberFormat = "mm/dd/yyyy"
'-->Insert analysis formulas and autofill down the range.
Range("G2").Select
ActiveCell.FormulaR1C1 =
"=IF(DAY(RC[-2])-LEFT(RC[-1],LEN(RC[-1])-5)=RC[-6],DATE(YEAR(RC[-2]),MONTH(RC[-2]),RC[-6]),IF(AND(LEFT(RC[-1],LEN(RC[-1])-5)>43,MONTH(RC[-3])<>MONTH(RC[-2])),DATE(YEAR(RC[-3]),MONTH(RC[-3]),RC[-6]),""Err!""))"
Range("H2").Select
ActiveCell.FormulaR1C1 =
"=IF(OR(LEFT(RC[-5],3)=""Mtg"",OR(LEFT(RC[-4],4)=""#N/A"",LEFT(RC[-3],4)=""#N/A"")),IF(RC[-5]=0,""ZERO
FACTOR"",""DELETE""),"" "")"
Range("I2").Select
ActiveCell.FormulaR1C1 =
"=IF(AND(DAY(TODAY())<8,(MONTH(RC[-4]))=12,MONTH(TODAY())=1,YEAR(TODAY())-YEAR(RC[-4])=1),""
"",IF(AND(DAY(TODAY())<8,MONTH(TODAY())-MONTH(RC[-4])=1),""
"",IF(OR(AND(YEAR(RC[-4])=YEAR(TODAY()),MONTH(RC[-4])=MONTH(TODAY())),AND(YEAR(RC[-4])-YEAR(TODAY())=1,MONTH(RC[-4])=1,MONTH(TODAY())=12),AND(YEAR(RC[-4])=YEAR(TODAY()),MONTH(RC[-4])-MONTH(TODAY())=1)),""
"",""Out-of-date"")))"

Range("G2:I2").Select
Selection.AutoFill Destination:=Range("G2:I" & RowOffset)
Range("G2:I" & RowOffset).Copy

'-->Make the Formulas values
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("A1").Select

End Sub

 

[Hugenstein]

I've simplified my code if someone can take a look at it.

If I do the first copy and paste manually (cols E:H), Excel clocks fo
almost a minute, but then functions normally. If I step through th
program, I get no problems until I reach the Exit Sub statement, an
then it freezes. Anyone ever experience anything like this?

Thanks again,
Ryan

=========================================
Sub FactorFormatAfterBB()

' Find range to Autofill

Range("A1").Select
If IsEmpty(Range("A6000")) = False Then
RowOffset = 5999
Range("A6000").Select
Else
If IsEmpty(Range("A3000")) = False Then
RowOffset = 2999
Range("A3000").Select
End If
End If

Do While IsEmpty(ActiveCell) = False
ActiveCell.Offset(R + 1, C).Select
RowOffset = RowOffset + 1
Loop

Range("E2:H" & RowOffset).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
SkipBlanks _
:=True, Transpose:=False

Range("A2").Select
Selection.Sort Key1:=Range("F2"), Order1:=xlAscending
Key2:=Range("A2") _
, Order2:=xlAscending, Header:=xlYes, OrderCustom:=1
MatchCase:=False _
, Orientation:=xlTopToBottom

Range("I1").Select
ActiveCell.FormulaR1C1 = "CAMRA Factor Dt"
Columns("I:I").ColumnWidth = 15.57
Range("j1").Select
ActiveCell.FormulaR1C1 = "N/A Chk"
Range("k1").Select
ActiveCell.FormulaR1C1 = "Past Chk"

Range("C").Select
Selection.Delete Shift:=xlToLeft
Range("E8").Select
Range("A1").Select
Selection.AutoFilter

Range("G2").Select
ActiveCell.FormulaR1C1 = "Err!"
Range("H2").Select
ActiveCell.FormulaR1C1 = "DELETE"
Range("I2").Select
ActiveCell.FormulaR1C1 = "Out-of-date"
Range("G2:I2").Select
Selection.AutoFill Destination:=Range("G2:I" & RowOffset)
Range("G2:I" & RowOffset).Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
SkipBlanks _
:=True, Transpose:=False

Application.DisplayAlerts = False
Range("Z1").Select
ActiveCell.FormulaR1C1 = _

"=CONCATENATE(""h:\dataclnp\factors\"",MONTH(TODAY()),DAY(TODAY()),YEAR(TODAY()),""bb.xls"")"
SaveLoc = Range("Z1")
ActiveWorkbook.SaveAs Filename:=SaveLoc, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False

Application.DisplayAlerts = True

'-->An attempt to end the Sub without the locking

If RowOffset > 0 Then Exit Sub

End Su