Simple VB Loop

[MAdcock]

I am trying to create a do loop that will delete rows when the value in a column is 'Sale' or 'Distribution' and I need it to run until it reaches the bottom of the spreadsheet (incorporating blank cells along the way). Once this is complete, the data then needs to be output into a need tab.

I have tried and tried, but excel just freezes. It might be my coding (probably). I know this is minor, but help is needed quickly.

Many thanks

[willakawill]

I am trying to create a do loop that will delete rows when the value in a column is 'Sale' or 'Distribution' and I need it to run until it reaches the bottom of the spreadsheet (incorporating blank cells along the way). Once this is complete, the data then needs to be output into a need tab.

I have tried and tried, but excel just freezes. It might be my coding (probably). I know this is minor, but help is needed quickly.

Many thanks

Sound like you have an endless loop
Would you please post your code as that will be the fastest way to a solution
Thanks

[MAdcock]

Sound like you have an endless loop
Would you please post your code as that will be the fastest way to a solution
Thanks

Code is as follows (so far):

Sub GetCache()

Sheets("Purchas esSales").Selec t
Range("A:K").Se lect
Selection.Copy

Sheets("Cache") .Select
Range("A1").Sel ect
Selection.Paste Special Paste:=xlPasteV alues, Operation:=xlNo ne, SkipBlanks _
:=False, Transpose:=Fals e

Sheets("Cache") .Select
Range("B2:B1000 0").Select
Do Until ActiveCell.Valu e = 0
If ActiveCell.Valu e = "Sale" Then
ActiveCell.Enti reRow.Select
Selection.Delet e Shift:=xlUp
ElseIf ActiveCell.Valu e = "Purchase" Then
ActiveCell.Enti reRow.Select
Selection.Delet e Shift:=xlUp
ElseIf ActiveCell.Valu e = "Distributi on" Then
ActiveCell.Enti reRow.Select
Selection.Delet e Shift:=xlUp
ElseIf ActiveCell.Valu e = " " Then
ActiveCell.Enti reRow.Select
Selection.Delet e Shift:=xlUp
ActiveCell.Offs et(1, 1).Select
End If
Loop

End Sub

[willakawill]

Code is as follows (so far):

Sub GetCache()

Sheets("Purchas esSales").Selec t
Range("A:K").Se lect
Selection.Copy

Sheets("Cache") .Select
Range("A1").Sel ect
Selection.Paste Special Paste:=xlPasteV alues, Operation:=xlNo ne, SkipBlanks _
:=False, Transpose:=Fals e

Sheets("Cache") .Select
Range("B2:B1000 0").Select
Do Until ActiveCell.Valu e = 0
If ActiveCell.Valu e = "Sale" Then
ActiveCell.Enti reRow.Select
Selection.Delet e Shift:=xlUp
ElseIf ActiveCell.Valu e = "Purchase" Then
ActiveCell.Enti reRow.Select
Selection.Delet e Shift:=xlUp
ElseIf ActiveCell.Valu e = "Distributi on" Then
ActiveCell.Enti reRow.Select
Selection.Delet e Shift:=xlUp
ElseIf ActiveCell.Valu e = " " Then
ActiveCell.Enti reRow.Select
Selection.Delet e Shift:=xlUp
ActiveCell.Offs et(1, 1).Select
End If
Loop

End Sub

Hi. Thanks for the code.
You are running a risk of an endless loop by looking for the condition 0
Do Until ActiveCell.Valu e = 0

Also this might be easier to read, debug

Select Case ActiveCell.Valu e
Case "Sale", "Purchase", "Distributi on"
ActiveCell.Enti reRow.Select
Selection.Delet e Shift:=xlUp

Case " "
ActiveCell.Enti reRow.Select
Selection.Delet e Shift:=xlUp
ActiveCell.Offs et(1, 1).Select
End Select

What exactly do you intend to do with that last statement;
ActiveCell.Offs et(1, 1).Select

[Killer42]

You are running a risk of an endless loop by looking for the condition 0
Do Until ActiveCell.Valu e = 0

Perhaps as a first cut, this could be changed to watch for null?

Also, is it in fact locked, or could it simply be taking longer than expected? It might be a good idea to insert a DoEvents just before the Loop statement.

[MAdcock]

Hi. Thanks for the code.
You are running a risk of an endless loop by looking for the condition 0
Do Until ActiveCell.Valu e = 0

Also this might be easier to read, debug

Select Case ActiveCell.Valu e
Case "Sale", "Purchase", "Distributi on"
ActiveCell.Enti reRow.Select
Selection.Delet e Shift:=xlUp

Case " "
ActiveCell.Enti reRow.Select
Selection.Delet e Shift:=xlUp
ActiveCell.Offs et(1, 1).Select
End Select

What exactly do you intend to do with that last statement;
ActiveCell.Offs et(1, 1).Select

I have tried your code, but it results in the same problem, that my Excel freezes and I have to restart the application.

All I want is for the lines in the spreadsheet with Distribution, Sale, Purchase in column B to be deleted. Is anyone able to write a quick piece of code that will do this process? Ive tried till im blue!

The ActiveCell.Offs et statement was to move the curosr down to the next line.

HELP!

[willakawill]

I have tried your code, but it results in the same problem, that my Excel freezes and I have to restart the application.

All I want is for the lines in the spreadsheet with Distribution, Sale, Purchase in column B to be deleted. Is anyone able to write a quick piece of code that will do this process? Ive tried till im blue!

The ActiveCell.Offs et statement was to move the curosr down to the next line.

HELP!

Yes it will move it down one row. It will also move it to the right by one column.
The code you are using works. I just tested it. There are two problems. First you are only exiting the loop if you encounter 0. This works if there is one and locks you into a permanent loop if there isn't one.
Second the Offset statement moves you to a new column. Try the code without the offset. Put a counter in the code as a safety exit. You are looking through 10,000 rows so;

Dim intCounter As Integer

'and inside your loop
intCounter = intCouter + 1
If intCounter = 10000 Then
Exit Sub
End If

[Killer42]

Another important point. If you have a DoEvents in there, you won't have to restart the application, even if you do get stuck in a loop - you can just interrupt the code. DoEvents allows Windows to notice other things, like the Break key (or mouse-clicks).