Hi forum gurus,

I have a worksheet that needs to have its data re-orderd. This seems pretty straight forward, but I'm stumpped on how to use a found cell as the upper limit for another search range.

Basically, I want to find the word "Comment" within (:=xlPart) the text string of header-row cells. When the string "Comment" is found, then I want to look down that column to see if any actual comments are present (four or more letters-- What:="????*").
- If not, then continue to the next column where "Comment" is found in the header.
- If so, then cut the entire column and insert it (sequentially for multiple finds) after column ("H"); then continue to the next column where "Comment" is found in the header and repeat.

I get to the point of selecting the column range I want to search for actual comments, but then my search for comments looks across that row, instead of looking down the column. Here is my annotated vba code:

 Sub LastFndCmmt()
  'Almost works
   Const sFind As String = "Comment"
    Dim ColRng As Long
    Dim LastCol As Integer
    Dim LastRow As Long
        npaste = 1
    
'  Establish limits of data
    LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
    LastRow = Cells(Cells.Rows.Count, "C").End(xlUp).Row

' Search for "Comment" string in header row
    For ColRng = 1 To LastCol
        Cells.Find(What:=sFind, After:=Range("H1").Offset(0, npaste + 2), LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
       False, SearchFormat:=False).Activate

'begin next search one cell down so that the header string is not part of the search range
        ActiveCell.Offset(1, 0).Select

'Use selected cell as uppermost limit for a range to lastrow of that column
        Range(ActiveCell, ActiveCell.End(xlDown)).Select

'Search down the range for any text string with 4 or more characters
        With ActiveRange
            Cells.Find(What:="????*", After:=ActiveCell, LookIn:=xlValues, _
                LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False).EntireColumn.Select

' If a text string is found, then cut the entire column
            If Not Cells Is Nothing Then
                Selection.Cut

' Insert the cut column in successive columns following column "H"
            Columns("H:H").Offset(0, npaste).Select
            Selection.Insert Shift:=xlToRight
            npaste = npaste + 1
               End If
        End With
   Next
End Sub
Thanks very much in advance....

TucsonJack