Search for string across header row, then search for another string down found column

I think I got this to work.
Backup your data.

Sub MoveCommentColumns()
    Const sFind As String = "Comment"
    Dim nPasteCol As Long, nCol As Long, nLastCol As Long, nLastRow As Long
    Dim rg As Range, i As Long

    'Paste after column H
    nPasteCol = 8

    '  Establish range of data
    nLastCol = Cells(1, Columns.Count).End(xlToLeft).Column
    nLastRow = Cells(Cells.Rows.Count, "C").End(xlUp).Row
    
    ' Search for "Comment" string in header row
    For nCol = 1 To nLastCol
        If InStr(1, Cells(1, nCol), sFind, vbTextCompare) > 0 Then
            ' Search in Comment Column for any text greater than 4
            Set rg = Range(Cells(2, nCol), Cells(nLastRow, nCol))
            For i = 1 To rg.Rows.Count
                If Len(rg.Cells(i, 1)) > 4 Then
                    rg.EntireColumn.Select
                    rg.EntireColumn.Cut
                    ' Insert the cut column in successive columns following column "H"
                    nPasteCol = nPasteCol + 1
                    Columns(nPasteCol).Insert Shift:=xlToRight
                    Exit For
                End If
            Next i
        End If
   Next nCol
End Sub

StevenM,

Thank you so much. Your most elegant (compared to the clunky way I was approaching the problem) solution worked like a charm. I will study how you did this. I have much to learn.

I haven't discovered how to assign credit to your contribution. I hope the "solved" marker does so. Again... amazingly fine work.. Thank you.

TucsonJack