'Loop to process a column of data

I am trying to loop through a column of data and move all data below "south" but above "north"/"east"/"West". The data is random and tied to each title so I can't sort alphabetically.

Without the loop; I am able to sort the first cell under "south".

Dim rng As Range
Dim i As Integer
For i = 1 To rng.Rows.Count
    Dim rngFound As Range
    Dim rngFoundTrue As Range
 
    Set rngFound = Cells.Find(What:="SOUTH", After:=ActiveCell, LookIn:=xlFormulas, _
     LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
     MatchCase:=False, SearchFormat:=False)
 
    Set rngFoundTrue = rngFound.Offset(1, 0)
    rngFoundTrue.Cut Destination:=rngFoundTrue.Offset(0, 1)
    Set rngFound = Nothing
 
    Do Until rngFoundTrue.Value = "NORTH" Or "WEST" Or "EAST"
Next
End Sub


Sources

This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.

Source: Stack Overflow

Solution Source