ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Excel Locks up at end of Sub (https://www.excelbanter.com/excel-programming/339950-excel-locks-up-end-sub.html)

Hugenstein

Excel Locks up at end of Sub
 

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:D").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
------------------------------------------------------------------------
Hugenstein's Profile: http://www.excelforum.com/member.php...o&userid=22737
View this thread: http://www.excelforum.com/showthread...hreadid=467216


Hugenstein[_2_]

Excel Locks up at end of Sub
 

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:D").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

--
Hugenstei
-----------------------------------------------------------------------
Hugenstein's Profile: http://www.excelforum.com/member.php...fo&userid=2273
View this thread: http://www.excelforum.com/showthread.php?threadid=46721



All times are GMT +1. The time now is 07:41 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com