[GeoffreyBarnard]

To All, I'm trying to get the following code to loop. Can anyone please help. I've tried all sorts of things. I either get no loop or an infinite loop. Thanks Geoffrey Barnard

Sub Sort0s()
Dim MyCounter
MyCounter = 1
Do Until MyCounter = 11
Cells.Find(What:="0", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
True, SearchFormat:=False).Activate
ActiveCell.Offset(0, -1).Select
Range(Selection, Selection.End(xlDown)).Select

Selection.sort Key1:=ActiveCell, Order1:=xlDescending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

ActiveCell.Offset(0, 2).Select

MyCounter = MyCounter + 1
Loop

End Sub

[GeoffreyBarnard]

To All Thanks, But I've solved my Problem.