Joel you've been very helpful from the beginning and I offer you many many
thanks for sticking it out with me on this. Here is the routine I finally
worked up today that solves my problem:

Sub Button2_Click()

Dim StartCell As String

StartCell$ = "C14"
While StartCell$ < ""
StartCell$ = FindnMoveLowest(StartCell$)
Wend

End Sub

Public Function FindnMoveLowest(StartCell As String) As String

Dim MyCell, MyNext As Range
Dim Again As Boolean
Dim SortPriority As Integer
Dim StartRow As Integer
Dim StopRow As Integer

Set MyCell = ActiveSheet.Range(StartCell$)
TheTop% = MyCell.Row
Again = True
Do While Again
If Not IsEmpty(MyCell) Then
' Found a Priority Sort number, the head of a section
If SortPriority% 0 Then
' Other sections have been scanned thru
If MyCell.Value < SortPriority% Then
' This section has a lower Sort Priority number than the
previous lowest section
' so replace the previous section's info
SortPriority% = MyCell.Value
StartRow% = MyCell.Row
StopRow% = -1
Else
' We've found a new section but it's Sort Priority isn't
lower then the current lowest
' Record the end row of the current lowest section and
continue looking
StopRow% = MyCell.Row - 1
End If
Else
' This is the 1st section the code has scanned thru
SortPriority% = MyCell.Value
StartRow% = MyCell.Row
StopRow% = -1
End If
End If
On Error Resume Next
Set MyNext = MyCell.Offset(1, 0)
If Err 0 Or MyNext.Locked = True Then
Again = False
Err = 0
Else
Set MyCell = MyNext
End If
On Error GoTo 0
Loop
If StopRow% = -1 Then
StopRow% = MyCell.Row
End If

If StartRow% TheTop% Then
ActiveSheet.Unprotect
Rows(StartRow% & ":" & StopRow%).Cut
Rows(TheTop%).Insert
ActiveSheet.Protect
FindnMoveLowest = Left$(StartCell$, 1) & (Val(Mid$(StartCell$, 2)) +
StopRow% - StartRow% + 1)
Else
FindnMoveLowest = ""
End If

End Function

I'm recursively calling a function which looks for the lowest numbered row
(using StartCell$ as the starting point), records the beginning row and
ending row of the section, and then moves that section to the row where it
started it's search at. When it finally cannot find a section that it can
move, the routine stops.

I post this here in hopes that it may help somebody else that bumps into
this problem of the Excel Sort method causing formulas to get screwed up,
and so you can see what I finally did. However I don't think I could have
figured this out without your suggestions Joel as they made me think thru
the problem looking out-of-the-box for a solution.

I think what we both came up with finally is very similar.

Many thanks!

- Michael




"Joel" wrote in message
...
Does this code help?

Sub MoveSections()
'
' Macro1 Macro
' Macro recorded 6/19/2008 by Joel
'

'
Const RED = 3
Const Blue = 41
Const Green = 4
Const Yellow = 6

ColorOrder = Array(Yellow, Green, Blue, RED)


FirstRow = 1
For Each SectColor In ColorOrder
RowCount = 1
Foundcolor = False
Do While Range("A" & RowCount).Interior.ColorIndex < xlNone
Select Case Foundcolor
Case False
CellColor = _
Range("A" & RowCount).Interior.ColorIndex
If SectColor = CellColor Then
FirstColor = RowCount
Foundcolor = True
End If
Case True
NextColor = _
Range("A" & (RowCount + 1)).Interior.ColorIndex
If SectColor < NextColor Then
LastColor = RowCount
Exit Do
End If
End Select
RowCount = RowCount + 1
Loop
'test if section is in correct location don't move
If FirstColor < FirstRow Then
Rows(FirstColor & ":" & LastColor).Cut
Rows(FirstRow).Insert
End If
FirstRow = FirstRow + (LastColor - FirstColor + 1)
Next SectColor
End Sub