Macro getting stuck

[Linking to specific cells in pivot table]

Hi - I have multiple macros running back to back on the click event of a
button -- Excel seems to be getting stuck at the beginning of the last macro.
What's happening is that at the bottom of Excel, "Cell" shows up with a
bunch of blue bars prior to getting to the last macro (looks like Excel is
updating cells?) -- Excel moves to the last macro which starts by copying all
cells from one sheet and pasting to another sheet -- it is at this point that
Excel fails to move on -- specifically, Excel pastes the cells onto the new
sheet but fails to move on (the "Cell" with the blue bars at the bottom still
shows).

I tried the "Wait" function for 60 seconds (inserted this into the second to
last macro), but this doesn't help...any ideas on what might be causing this
problem and how to get around it? Below is the code for the last two macros
(again, Excel's getting stuck at the beginning of the last one).

Sub textformat()

Dim textformatcell
Dim newHour
Dim newMinute
Dim newSecond
Dim waitTime

Sheets("Cntrywd Lookups").Select
Range("A11").Select

Do
Sheets("Cntrywd Lookups").Select
ActiveCell.Offset(1, 0).Select
Set textformatcell = ActiveCell

Sheets("Cntrywd Rate Sum step 1").Select

Cells.Find(What:=textformatcell, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False).Activate
Selection.Font.Bold = True

If ActiveCell.Value = "PROGRAM DETAILS" Then
Exit Do

End If

Loop

Cells.Find(What:="PayOption Adjustments", After:=ActiveCell,
LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False).Activate

ActiveCell.Offset(1, 0).Select
Selection.End(xlToRight).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight

newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 60
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime


End Sub

Sub cntryformula()

Dim cntrydayrange
Dim cntryreference

Sheets("Cntrywd Rate Sum step 1").Select
Cells.Select
Selection.Copy

Sheets("Cntrywd Rate Sum - color coded").Select
Cells.Select
ActiveSheet.Paste

Sheets("Cntrywd Lookups").Select
Range("A1").Select

Do

Sheets("Cntrywd Lookups").Select
Set cntryxx = ActiveCell.Offset(1, 0)
ActiveCell.Offset(1, 0).Select

Sheets("Cntrywd Rate Sum - color coded").Select
Cells.Find(What:=cntryxx, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Cells.Find(What:="day", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate

Set cntryreference = ActiveCell.Offset(1, 0)

Range(Selection, Selection.End(xlToRight)).Select
Set cntrydayrange = ActiveWindow.RangeSelection

Sheets("Worksheet Formulas").Select
Cells.Find(What:="Countrywide Day Adjustment Formula",
After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Offset(0, 1).Copy

Sheets("Cntrywd Rate Sum - color coded").Select
cntrydayrange.Select
ActiveSheet.Paste

Sheets("Worksheet Formulas").Select
Cells.Find(What:="Countrywide Rate Adjustment Formula",
After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Offset(0, 1).Copy

Sheets("Cntrywd Rate Sum - color coded").Select
cntryreference.Select

Selection.End(xlToRight).Select
Selection.End(xlDown).Select
Range(Selection, cntryreference).Select
ActiveSheet.Paste

If cntryxx = "NonConf ARM 6m LIB IO w/3y Prepay" Then
Exit Do
End If

Loop

End Sub

 

[Dick Kusleika]

It sounds like you're copying a lot of information from one sheet to the
other. Depending on the amount of informatin and the speed of your computer
it can take some time. I don't think the macro is getting stuck. I think
if you let it run for a couple of hours it will finish. The nature of the
data in the cells can cause it to slow down too.

If I take two sheets and in one of them put a value in Cell A1, I can copy
all the cells in that sheet to the other in a milisecond. If, however, I
put a value in A1 and in IV65536 (just two values in the whole sheet), it
takes about 8 seconds to copy. So it's not just how much data, but also how
spread out the data is.

The quick and incorrect answer is to copy the sheet instead of the cells

Sheets("Cntrywd Rate Sum step 1").Select
Cells.Select
Selection.Copy

Sheets("Cntrywd Rate Sum - color coded").Select
Cells.Select
ActiveSheet.Paste

Application.DisplayAlerts = False
Sheets("Cntrywd Rate Sum - color coded").Delete
Application.DisplayAlerts = True
Sheets("Cntrywd Rate Sum step1").Copy
Activesheet.Name = "Cntrywd Rate Sum - color codeed"

That doesn't get to the root of the problem though. You need to figure out,
in your data, what's causing it to run so slow. Maybe you have a stray
piece of data way down the page that's causing you to copy 1,000,000 cells
instead of 1,000.

Next, and unrelated to your problem, you need to rewrite the macro to get
rid of all the Selects and Activates. It will make your code faster and
easier to read. If you're interested in doing that and need some help, let
me know.

 

[Linking to specific cells in pivot table]

Thanks for the help Dick! Yes, I would really appreciate any advice you have
for making my code better - you mentioned I could get rid of all the
"Selects" and "Activates" -- can you let me know how to do this or where I go
to find out? Also, I noticed you are an "Excel MVP" -- how can I find out
about how to get that certification?

Thanks,

Rob

 

[Dick Kusleika]

Rob

Re: MVP's, check out

http://groups-beta.google.com/group...el.misc/browse_thread/thread/43f23cc675329ff/

Re: Selection

In general, whenever you have

SomeObject.Select
Selection.DoSomething

you should change it to

SomeObject.DoSomething

There are about a half a dozen instances where selecting is necessary. The
rest of the time it's not.

Here's how I would rewrite your code. I don't know all the logic behind
what you're doing, so you may be able to write it more efficiently than
this. However, it should give you some ideas about working with object
without selecting them.

Sub TextFormat()

Dim wshLookup As Worksheet
Dim wshStep1 As Worksheet
Dim rFound As Range
Dim sFirstAdd As String

Set wshLookup = ThisWorkbook.Sheets("Cntrywd Lookups")
Set wshStep1 = ThisWorkbook.Sheets("Cntrywd Rate Sum step 1")

Set rFound = wshStep1.Cells.Find( _
what:=wshLookup.Range("A12").Value, _
LookIn:=xlFormulas, _
lookat:=xlWhole)

If Not rFound Is Nothing Then
sFirstAdd = rFound.Address

Do
rFound.Font.Bold = True
Set rFound = wshStep1.Cells.FindNext(rFound)
Loop Until rFound.Address = sFirstAdd Or _
rFound.Value = "Program Details"
End If

Set rFound = wshStep1.Cells.Find( _
what:="PayOption Adjustments", _
LookIn:=xlFormulas, _
lookat:=xlWhole)

If Not rFound Is Nothing Then
With rFound.Offset(1, 0).End(xlToRight)
wshStep1.Range(.Item(1), .Item(1).End(xlDown)).Resize(,
3).Insert xlToRight
End With
End If

End Sub

Sub CntryFormula()

Dim wshStep1 As Worksheet
Dim wshColor As Worksheet
Dim wshLookup As Worksheet
Dim wshFormula As Worksheet
Dim rFound As Range
Dim rDay As Range
Dim rForm As Range
Dim rLook As Range

With ThisWorkbook
Set wshStep1 = .Sheets("Cntrywd Rate Sum step 1")
Set wshColor = .Sheets("Cntrywd Rate Sum - color coded")
Set wshLookup = .Sheets("Cntrywd Lookups")
Set wshFormula = .Sheets("Worksheet Formulas")
End With

wshStep1.UsedRange.Copy wshColor.Range("A1")
Set rLook = wshLookup.Range("a1")

Do
Set rLook = rLook.Offset(1, 0)

Set rFound = wshColor.Cells.Find( _
what:=rLook.Value, _
LookIn:=xlFormulas, _
lookat:=xlWhole)

If Not rFound Is Nothing Then
Set rDay = wshColor.Cells.Find( _
what:="day", _
after:=rFound, _
LookIn:=xlFormulas, _
lookat:=xlPart)

If Not rDay Is Nothing Then
With rDay.Offset(1, 0)
Set rDay = wshColor.Range(.Item(1),
..Item(1).End(xlToRight))
End With

Set rForm = wshFormula.Cells.Find( _
what:="Countrywide Day Adjustment Formula", _
LookIn:=xlFormulas, _
lookat:=xlPart)

rForm.Offset(0, 1).Copy rDay 'Not sure about this

End If
End If
Loop Until rLook.Value = "NonConf ARM 6m LIB IO w/3y Prepay"

End Sub

 

[Linking to specific cells in pivot table]

Dick - I can't thank you enough for the help!!! I meant to write sooner but
some urgent things came up over the last month. I really appreciate your
input and support!!

Rob