Sorting by number of character in cell

[Khanonline]

Hi All,


I need some help in generating Sording Order of Excel Sheet.
I want to sort the data of column A by having the number of charater in it. Let suppose in the attached sheet
"Asset excluding Capital Value" has the highest number of Character so it should be on top along with other
values in Column B i.e 250; similarly "Asset without Interest" on Second ; "Asset with Interest" on third and onward.


I have about 1000+ Rows which I have to sort and I can not do it manually. So Macro required that do it in Descending order by counting the number of character in complet cell.
Note: If the number of character come equal somewhere that will not be problem.


Thanks in advance for quick responses

[mikerickson]

I haven't seen your file, but if you adjust the argument(s) for the call to SortByLength, this should work.

Sub sortRange()
Call SortByLength(Range("A1:B10"), 1, True)
End Sub

Sub SortByLength(sortRange As Range, keyColumn As Long, Optional Descending As Boolean)
Dim arrUnsorted As Variant, arrSorted As Variant
Dim rowSize As Long
Dim arrRowIndices() As Long
Dim i As Long, j As Long, temp As Long

rowSize = sortRange.Rows.Count
arrUnsorted = sortRange.Value
ReDim arrRowIndices(1 To rowSize)
For i = 1 To rowSize
arrRowIndices(i) = i
Next i

For i = 1 To rowSize - 1
For j = i + 1 To rowSize
If LT(arrUnsorted(arrRowIndices(j), keyColumn), arrUnsorted(arrRowIndices(i), keyColumn)) Xor Descending Then
temp = arrRowIndices(i)
arrRowIndices(i) = arrRowIndices(j)
arrRowIndices(j) = temp
End If
Next j
Next i

arrSorted = arrUnsorted
For i = 1 To rowSize
For j = 1 To UBound(arrUnsorted, 2)
arrSorted(i, j) = arrUnsorted(arrRowIndices(i), j)
Next j
Next i

sortRange.Value = arrSorted
End Sub

Function LT(a As Variant, b As Variant)
If Len(CStr(a)) = Len(CStr(b)) Then
LT = (a < b)
Else
LT = (Len(CStr(a)) < Len(CStr(b)))
End If
End Function

This uses a bubble sort routine. The same arrRowIndices and LT approach can be used with a QuickSort or other method.

[snb]

Without sorting:


Sub M_snb()
sn = [A1:B5]
sp = Split(Space([max(len(A1:A5))]))

For j = 1 To UBound(sn)
sp(UBound(sp) - Len(sn(j, 1))) = sp(UBound(sp) - Len(sn(j, 1))) & sn(j, 1) & "_" & sn(j, 2) & ","
Next
sp = Split(Join(Filter(sp, ","), ""), ",")

With Cells(20, 1).Resize(UBound(sp) + 1)
.Value = Application.Transpose(sp)
.TextToColumns , , , , 0, 0, 0, 0, -1, "_"
End With
End Sub

[apo]

Here's my stab at it..



Private Sub CommandButton1_Click()
Dim i As Long, x
x = [A1:B5]
With CreateObject("System.Collections.ArrayList")
For i = LBound(x) To UBound(x)
.Add Format(Len(x(i, 1)), "00") & "|" & x(i, 1) & "|" & x(i, 2)
Next i
.Sort: .Reverse
[D1].Resize(UBound(x)) = Application.Transpose(.toarray())
[D1].Resize(UBound(x)).TextToColumns , , , , 0, 0, 0, 0, -1, "|"
[D1].Resize(UBound(x)).Delete
End With
End Sub

[Khanonline]

Great Effort Guys. Thanks alot to All. Macros resolved the issue.