Endless loop?

[John]

I have a piece of code that I am experimenting with and it crashes my
excel... have I set up an endless loop? The idea is that if a certian column
in the sheet equals "true" then cut that row and paste it into a new sheet.

Thanks for the help!

Sub NI()
'

'
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Sheets("t0983101").Select
Range("E4").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("A4").Select
Dim rngToSearch As Range
Dim wks As Worksheet
Dim rngFound As Range

Set wks = Sheets("t0983101")
Set rngToSearch = wks.Columns(24)

Set rngFound = rngToSearch.Find("true")
If rngFound Is Nothing Then
MsgBox "No NI Trades Found"
Else
Do
rngFound.EntireRow.Cut
Sheets("NI").Select
Range("A9").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Set rngFound = rngToSearch.FindNext
Loop Until rngFound Is Nothing
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

 

[Henry]

John,

If you look in help for FIND, you will see that it will go on for ever if
you don't stop it.
What you need to do is to capture the first address found and check that
Find has not looped back to that address, at the end of your Loop.

Set rngFound = rngToSearch.Find("true")
FirstAdd =rngFound
...
..
..
..
..
Set rngFound = rngToSearch.FindNext
Loop Until rngFound Is Nothing Or FirstAdd = rngFound

Henry

 

[John]

Nevermind, I think It is due to the 7000 rows I am trying to sort through...

 

[FSt1]

hi,
i think it is the cut/copy part of your do loop that is crashing the macro.
it has been my experience that the cut and copy commands should not be used
in a macro excessively. once or twice is ok but with inside a loop, i
wouldn't have done it that way.
you can add this just before the cut command.

Application.CutCopyMode = False

that will clear the clipboard.
if that don't work then you will have to use another way. maybe with
variable. post back if it don't work and is before 4:00Pm EDT US.

regards

FSt1

 

[John]

On a smaller sample of data, I have found that the code actually cuts and
copies every row... not just rows that contain "true" in the 24th column.
That is particularly perplexing....

The cut and paste part of the code seems to be working fine however.

 

[John]

If I copy and paste values in my formula (true/false) column it all works
fine... again assuming a smaller sample size...

 

[John]

is there a way to tell the code to "find" only cell values... rather than the
formula itslef? In other words, is there a way that i won't have to copy and
paste values for the code to work.

 

[FSt1]

hi
yes it seems to work fine but what is happening this the copy/paste uses the
clipboard and it eats up the memory. crash usually occurs with out of memory
messages. this in not unique to xl. i had the same probem with lotus. cut
seems to be worse that copy.
have you tried henry's suggestion?

FSt1

 

[STEVE BELL]

John,

Are you looking for something like

set rng1 = Sheets("Sheet1").Range("A15")
set rng2 = Sheets("Sheet2").Range("M610")
rng2.value = rng1.value

or
Sheets("Sheet2).Cell(x,y).value = Sheets("Sheet1").Cell(a,b).value

no copy/paste needed.

 

[John]

the problem now is that excel searches column 24 and finds every column since
I have "true" in the formulas... As I said... if I copy and paste values
over the entire column (24) then the code works.

My question is... "Is there anyway to tell excel to search for cell values
that equal true and not just "true" in the formula that is in each cell. For
example, =IF(E5=t0983101!$X$4,TRUE,FALSE)... this triggers the cut and paste
in the macro... even though the formula result of this cell is false.

Thanks again.

 

[John]

steve,

thanks for the suggestion. I am not sure what that code is doing. Could
you explain what that does so I can figure out how to stick it into my code?

 

[John]

apologies if what I am refering to in the copy and paste... here is the
slightly modified code... I am copying and pasting column 24 to get values
into that column...

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Sheets("t0983101").Select
Range("x6").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("A4").Select
Dim rngToSearch As Range
Dim wks As Worksheet
Dim rngFound As Range

Set wks = Sheets("t0983101")
Set rngToSearch = wks.Columns(24)

Set rngFound = rngToSearch.Find("true")
firstadd = rngFound
If rngFound Is Nothing Then
MsgBox "No NI Trades Found"
Else
Do
rngFound.EntireRow.Cut
Sheets("NI").Select
Range("A9").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Set rngFound = rngToSearch.FindNext
Loop Until rngFound Is Nothing
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

 

[FSt1]

john,
I have to go do my end of day stuff. Steve has the solution i think. if i
can't get back today, post again tomorrow and i will get back with you on
this thread.

Sorry i have to leave.
regards
FSt2

 

[STEVE BELL]

Found this little trick when using find:

Selection.Find(What:="true", After:=ActiveCell, LookIn:=xlValues, LookAt
_
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:= _
False).Activate

The trick comes by using: LookIn:=xlValues
Only picked cells that returned TRUE... Ignored cells that returned FALSE.

 

[John]

steve, looks great but I am getting several errors. would you mind putting
in my code that i posted earlier? Or just explain where this new code should
go... Looks like it should work though.

Thanks!

 

[STEVE BELL]

John,

Instead of selecting a range, copying it, selecting another range, and
pasting.
You first set the range to copy from
set rng1 = Sheets("Sheet1").Range(Cells(rw1, col1), Cells(rw2,
col2))

rw1, rw2, col1, and col2 can be variables that you first determine

Set rng2 = Sheets("Sheet2").Range(Cells(rw1+x,col1+y),Cells(rw2 + x,
col2+y)
This must be a range of the same size.
x & y are offset values if you don't want to put them into the equivalent
range.

Sheets are included only if you want to use 2 separate worksheets.

than you just exchange the values from one range to the other:
rng2.Value = rng1.Value
works on a multi-cell range on on a single cell.

Range("x6").Select

Range(Selection, Selection.End(xlDown)).Select

you can replace this with
dim rw1 as long, rw2 as long, col1 as long, col2 as long, x as long, y as
long

rw1 = 6
rw2 = Range("X6").End(xlDown).Row
col1 = 24

set rng1 = Range(cells(rw1,col1),cells(rw2,col1))

now you just need to do the same for rng2

let me know if this helps.

steveB

Remove "AYN" from email to respond

 

[John]

specifically I get a "named argument not found" error... the LookAt portion
of the code is highlighted...

 

[John]

I have to leave for the day, but I will check the post tomorrow. Thanks
again for all the help Steve and FSt1

 

[STEVE BELL]

John,

If I followed your code - you just want to find each occurance of True and
transfer it to sheet NI (?)
This code should do it without selecting anything.

let me know if it works.
===================================================
Sub NI()
'
Dim rw1 As Long, rw2 As Long
Dim rngToSearch As Range
Dim wks As Worksheet
Dim rngFound As Range

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

Set wks = Sheets("t0983101")
Set rngToSearch = wks.Columns(24)

' replace formula with value
rw1 = wks.Range("E4").End(xlDown).Row
wks.Cells(rw1, 5).Value = wks.Cells(rw1, 5).Value

' Find all occurances of True and transfer to sheet NI
Do Until rw1 = 0
On Error Resume Next
rw1 = 0
rw1 = rngToSearch.Find(What:="true", After:=ActiveCell, LookIn:=xlValues,
LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False).Row
On Error GoTo 0
If rw1 > 0 Then
rw2 = Sheets("NI").Range("A9").End(xlDown) + 1
Sheets("NI").Cells(rw2, 1).Value = wks.Cells(rw1, 24).Value
wks.Cells(rw1, 24).ClearContents
Else
rw1 = 0
MsgBox "No NI Trades Found"
End If
Loop

Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
End Sub
===================================================

 

[John]

Steve, I get a type mismatch on this row...

rw2 = Sheets("NI").Range("A9").End(xlDown) + 1

I also took out the line; rw1 = 0 since I was getting the message box for No
NI Trades all the time... not sure if that is causing a problem.