Looping Macro

[Pete]

I have this looping macro that work like a gem. But it has
one glich or thing I would like to fix.

When the macro is running and it encounters a empty cell I
want it to stop running in the coloum it started in, move
to the top of the worksheet, move over 9 cells and start
agian.

Can anyone help me see the light on this.

Do
ActiveCell.Name = "Sort2"
ActiveCell.Offset(0, 6).Range("A1").Select
ActiveCell.Name = "Sort3"
Range("Sort2:Sort3").Select
Selection.Sort Key1:=Range("Sort2"),
Order1:=xlAscending, Orientation:=xlLeftToRight
Range("Sort2").Select
Application.CutCopyMode = False
ActiveWorkbook.Names("Sort2").Delete
ActiveWorkbook.Names("Sort3").Delete
ActiveCell.Offset(1, 0).Select
If Empty Then Exit Do
Loop
End Sub

The if Empty does nothing, the loop contiues to the last
row of the spread sheet.

Pete

 

[Bob Phillips]

Pete,

This is the sort of thing, but what stops the outer loop?

Do
Do
With ActiveCell
.Name = "Sort2"
.Offset(0, 6).Range("A1").Select
.Name = "Sort3"
End With
Range("Sort2:Sort3").Select
Selection.Sort Key1:=Range("Sort2"), _
Order1:=xlAscending, _
Orientation:=xlLeftToRight
Range("Sort2").Select
Application.CutCopyMode = False
ActiveWorkbook.Names("Sort2").Delete
ActiveWorkbook.Names("Sort3").Delete
ActiveCell.Offset(1, 0).Select
Loop Until IsEmpty(ActiveCell.Value)
ActiveCell.Offset(-ActiveCell.Row + 1, 9).Select
Loop Until >>>>> what <<<<

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

 

[Pete]

I want the loop to continue until it finds an empty cell
at the top of the sheet.

Pete

 

[Bob Phillips]

I would have thought there were enough clues in the code to work that one
out

Do
Do
With ActiveCell
.Name = "Sort2"
.Offset(0, 6).Range("A1").Select
.Name = "Sort3"
End With
Range("Sort2:Sort3").Select
Selection.Sort Key1:=Range("Sort2"), _
Order1:=xlAscending, _
Orientation:=xlLeftToRight
Range("Sort2").Select
Application.CutCopyMode = False
ActiveWorkbook.Names("Sort2").Delete
ActiveWorkbook.Names("Sort3").Delete
ActiveCell.Offset(1, 0).Select
Loop Until IsEmpty(ActiveCell.Value)
ActiveCell.Offset(-ActiveCell.Row + 1, 9).Select
Loop Until IsEmpty(ActiveCell.Value)

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)