Hi meabrams,

Try the following (changes in red):
Sub SortByLength()
    Dim lLoop As Long
    Dim lLoop2 As Long
    Dim str1 As String
    Dim str2 As String
    Dim MyArray As Variant
    Dim lLastRow As Long
     

    MyArray = Range("A52:A54") 'works if set to Range("A1:A3")
     'Sort array
    For lLoop = 1 To UBound(MyArray)
        For lLoop2 = lLoop To UBound(MyArray)
            If Len(MyArray(lLoop2, 1)) > Len(MyArray(lLoop, 1)) Then
                str1 = MyArray(lLoop, 1)
                str2 = MyArray(lLoop2, 1)
                MyArray(lLoop, 1) = str2
                MyArray(lLoop2, 1) = str1
            End If
        Next lLoop2
    Next lLoop
     'Output sorted array
    Range("A52:A" & (51 + UBound(MyArray))) = (MyArray)
End Sub
Lewis