VB for excel, how do I loop through code

[steve hobden via OfficeKB.com]

When trying to loop through code I get a compile error "loop without do".

The code should should start in cell A4 (sheet1), check if its value equals
that in t5 (sheet3). If it does, then it cuts A4:A14(sheet1) and pastes
into a7(sheet2).

It then does the same for B4, C4, D4 etc. and continues until it reaches an
empty cell. See code below

Sheets("sheet1").Select
Range("a4").Select
Do While Not IsEmpty(ActiveCell)
If ActiveCell = Sheets("sheet3").Range("t5") Then
ActiveCell.Select
Selection.Resize(1, 10).Select
Selection.Cut Destination:=Sheets("Sheet2").Range("a7")
Else
ActiveCell.Offset(1, 0).Select
Loop

Eventually I want to change the destination cell for pasting to be "the
first empty cell below A6" rather than "A7", but first things first.

Many thanks

Steve

 

[Guest]

Your Loop statement is within an If..Then..Else block, so it isn't associated
with the Do While statement. Put an End IF before the Loop

VBA does much better if you don't Select cells - just reference them.
Something like this

Dim rng As Range
Dim i As Integer


With Worksheets("Sheet1").Range("4:4")
i = 1
Do While True
If Not IsEmpty(.Cells(i)) Then
.Cells(i).Resize(10, 1).Copy Sheets("Sheet2").Range("a7").Offset((i -
1) * 10, 0)

Else
Exit Do
End If
i = i + 1
Loop

End With

 

[JE McGimpsey]

You forgot an End If just before Loop - so the parser thinks you're
trying to loop within an If...End If structure.

Note that your description and your code don't match. Assuming the logic
in your code is correct, you might try something like this:

Dim vT5 As Variant
Dim rCell As Range
Dim rSource As Range
Dim rDest As Range

With Sheets("sheet1")
Set rSource = .Range("A4:A" & .Range("A" & _
Rows.Count).End(xlUp).Row)
End With
With Sheets("sheet2")
Set rDest = .Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
If rDest.Row < 7 Then Set rDest = .Range("A7")
End With
vT5 = Sheets("sheet3").Range("T5").Value

For Each rCell In rSource
With rCell
If .Value = vT5 Then
.Resize(1, 10).Cut Destination:=rDest
Set rDest = rDest.Offset(1, 0)
End If
End With
Next rCell