Accending Order

Karan001 · May 17, 2011

Hi Experts,
I have a column where there are so many value in rows.My requirement is to arrange all the row value in accending orders.

Available Value :

<TABLE style="WIDTH: 313pt; BORDER-COLLAPSE: collapse" border=0 cellSpacing=0 cellPadding=0 width=417><COLGROUP><COL style="WIDTH: 313pt; mso-width-source: userset; mso-width-alt: 15250" width=417><TBODY><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; WIDTH: 313pt; HEIGHT: 15pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl63 height=20 width=417>8Weeks/1Week/4Weeks/1Year/2Years/26Weeks/12Weeks</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl63 height=20>4Weeks/1Week/5Years/12Weeks/1.5 Year</TD></TR></TBODY></TABLE>

Requirement :-

<TABLE style="WIDTH: 339pt; BORDER-COLLAPSE: collapse" border=0 cellSpacing=0 cellPadding=0 width=452><COLGROUP><COL style="WIDTH: 339pt; mso-width-source: userset; mso-width-alt: 16530" width=452><TBODY><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; WIDTH: 339pt; HEIGHT: 15pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl66 height=20 width=452>1Week/4Weeks/8Weeks/12Weeks/26Weeks/1Year/2Years</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; WIDTH: 339pt; HEIGHT: 15pt; BORDER-TOP: #ece9d8; BORDER-RIGHT: windowtext 0.5pt solid" class=xl65 height=20 width=452>1Week/4Weeks/12Weeks/1.5 Year/5Years</TD></TR></TBODY></TABLE>

Regards,
Karan

Jon von der Heyden · May 17, 2011

Try;

Code:

Public Sub SortRows()
    Dim rngRow As Range
    Dim rngTable As Range
    
    Set rngTable = [B][COLOR="Red"]Range("A1:H20")[/COLOR][/B]'Change this bit
    
    For Each rngRow In rngTable.Rows
        rngRow.Sort Key1:=rngRow.Resize(1, 1), Order1:=xlAscending, Orientation:=xlSortRows, Header:=xlNo
    Next rngRow
End Sub

Karan001 · May 17, 2011

Hi Hayden,
I tried your code but not working can you check it.Because when i running macro no change happened.For your information both the value is in A1 & A2 Cell respectively

Regards,
Karan

Jon von der Heyden · May 17, 2011

Do you mean that the entire string "8Weeks/1Week/4Weeks/1Year/2Years/26Weeks/12Weeks" is contained in a single cell?

Karan001 · May 17, 2011

Dear Heyden,
You are right it is contain in a single cell.

Regards,
Karan

Krishnakumar · May 17, 2011

Hi,

I think this is the continuation of this thread

try

Code:

Function KARAN(ByRef r As Range) As String
Dim x, i As Long, d As Object, w, y
Dim PosW As Long, PosY As Long
Set d = CreateObject("scripting.dictionary")
    d.comparemode = 1
With CreateObject("scripting.dictionary")
    .comparemode = 1
    x = Split(r.Value, "/")
    For i = 0 To UBound(x)
        PosW = InStr(1, x(i), "week", 1)
        If PosW Then
            .Item(Format(Left(x(i), PosW - 1), "00") & Mid$(x(i), PosW)) = Empty
        Else
            PosY = InStr(1, x(i), "year", 1)
            d.Item(Format(Left(x(i), PosY - 1), "00") & Mid$(x(i), PosY)) = Empty
        End If
    Next
    If .Count Then w = Join$(SortCell(.keys), "/")
    If d.Count Then
        KARAN = w & "/" & Join$(SortCell(d.keys), "/")
    Else
        KARAN = w
    End If
End With
End Function
Function SortCell(ByRef v)
    Dim i   As Long, j As Long, t
    For i = LBound(v) To UBound(v)
        For j = i To UBound(v)
            If v(j) < v(i) Then
                t = v(i)
                v(i) = v(j)
                v(j) = t
            End If
        Next
    Next
    SortCell = v
End Function

Peter_SSs · May 17, 2011

Krishnakumar said:
Hi,

I think this is the continuation of this thread

Kris

1. The previous thread was about removing duplicates from the cells whereas this one is about sorting the data in the the cells so I think it is okay to be a separate thread.

2. For me, your suggestion here doesn't quite work with the given data (and a few extra rows I have added).

Excel Workbook

A

B

2

8Weeks/1Week/4Weeks/1Year/2Years/26Weeks/12Weeks

01Week/04Weeks/08Weeks/12Weeks/26Weeks/01Year/02Years

3

4Weeks/1Week/5Years/12Weeks/1.5 Year

01Week/04Weeks/12Weeks/02Year/05Years

4

3 Years

/03Years

5

2Weeks

02Weeks

6

4Weeks/105.5Week/5Years/12Weeks/1.5 Year

04Weeks/106Week/12Weeks/02Year/05Years

Arrange Text in Order (3)

Karan

My suggestion actually replaces the original data so definitely should be tested in a copy of your workbook. If you need help with how to modify to suit a different layout or to put this somewhere other than over the original data, post back with more details.

Before code:

Excel Workbook

A

1

2

8Weeks/1Week/4Weeks/1Year/2Years/26Weeks/12Weeks

3

4Weeks/1Week/5Years/12Weeks/1.5 Year

4

3 Years

5

2Weeks

6

4Weeks/105.5Week/5Years/12Weeks/1.5 Year

Arrange Text in Order (1)

Code:

 Sub Order_List() Dim DataRange As Range Dim Data, TempData, t Dim i As Long, j As Long, L As Long, M As Long Dim s As String Dim RX1 As Object, RX2 As Object Set RX1 = CreateObject("VBScript.RegExp") With RX1 .Pattern = "(.+?)(?=[A-Z ])" .Global = False .IgnoreCase = True End With Set RX2 = CreateObject("VBScript.RegExp") With RX2 .Pattern = "[A-Z]" .Global = False .IgnoreCase = True End With Application.ScreenUpdating = False Set DataRange = Range("A2", Range("A" & Rows.Count).End(xlUp)) Data = DataRange.Value L = UBound(Data, 1) Columns("B:C").Insert For i = 1 To L s = Data(i, 1) If InStr(1, s, "/") > 0 Then t = Split(s, "/") M = UBound(t) ReDim TempData(1 To M + 1, 1 To 3) For j = 0 To M TempData(j + 1, 1) = RX2.Execute(t(j))(0) TempData(j + 1, 2) = RX1.Execute(t(j))(0) TempData(j + 1, 3) = t(j) Next j With Range("B1:D" & M + 1) .Value = TempData .Sort Key1:=.Cells(1, 1), Order1:=xlAscending, Key2:=.Cells(1, 2), _ Order2:=xlAscending, Header:=xlNo Data(i, 1) = Join(Application.Transpose(.Offset(, 2).Resize(, 1).Value), "/") .ClearContents End With End If Next i Columns("B:D").Delete DataRange.Value = Data Application.ScreenUpdating = True End Sub 

After code:

Excel Workbook

A

1

2

1Week/4Weeks/8Weeks/12Weeks/26Weeks/1Year/2Years

3

1Week/4Weeks/12Weeks/1.5 Year/5Years

4

3 Years

5

2Weeks

6

4Weeks/12Weeks/105.5Week/1.5 Year/5Years

Arrange Text in Order (2)

MickG · May 17, 2011

Another option !!!

Code:

[COLOR="Navy"]Sub[/COLOR] MG17May16
[COLOR="Navy"]Dim[/COLOR] RStg
[COLOR="Navy"]Dim[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] w [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] y [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Temp [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] i [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] j [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] tx [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Ray
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & rows.Count).End(xlUp))
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
        w = 0
         y = 0
          RStg = Split(Dn, "/")
           [COLOR="Navy"]If[/COLOR] UBound(RStg) > 0 [COLOR="Navy"]Then[/COLOR]
             ReDim wk(1 To UBound(RStg))
              ReDim Yr(1 To UBound(RStg))
    [COLOR="Navy"]For[/COLOR] n = 0 To UBound(RStg)
        [COLOR="Navy"]If[/COLOR] InStr(RStg(n), "Week") [COLOR="Navy"]Then[/COLOR]
            w = w + 1
            wk(w) = Trim(Split(RStg(n), "W")(0))
        [COLOR="Navy"]ElseIf[/COLOR] InStr(RStg(n), "Year") [COLOR="Navy"]Then[/COLOR]
            y = y + 1
            Yr(y) = Trim(Split(RStg(n), "Y")(0))
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] n
ReDim Preserve wk(1 To w)
  ReDim Preserve Yr(1 To y)
    Ray = Array(wk, Yr)
    [COLOR="Navy"]For[/COLOR] n = 0 To UBound(Ray)
        [COLOR="Navy"]For[/COLOR] i = 1 To UBound(Ray(n))
            [COLOR="Navy"]For[/COLOR] j = i To UBound(Ray(n))
                [COLOR="Navy"]If[/COLOR] Val(Ray(n)(j)) < Val(Ray(n)(i)) [COLOR="Navy"]Then[/COLOR]
                    Temp = Ray(n)(i)
                    Ray(n)(i) = Ray(n)(j)
                    Ray(n)(j) = Temp
                [COLOR="Navy"]End[/COLOR] If
            [COLOR="Navy"]Next[/COLOR] j
        [COLOR="Navy"]Next[/COLOR] i
    [COLOR="Navy"]For[/COLOR] tx = 1 To UBound(Ray(n))
        [COLOR="Navy"]If[/COLOR] n = 0 [COLOR="Navy"]Then[/COLOR]
            Ray(n)(tx) = Ray(n)(tx) & "Week"
        [COLOR="Navy"]Else[/COLOR]
            Ray(n)(tx) = Ray(n)(tx) & "Year"
    [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] tx
[COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]With[/COLOR] Application
    Dn = Join(.Transpose(.Transpose(Ray(0))), "/") & "/" & Join(.Transpose(.Transpose(Ray(1))), "/")
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

Krishnakumar · May 17, 2011

Hi,

OK. Thanks Peter for checking the code. Here is the revised one.

Code:

Function KARAN(ByRef r As Range) As String
Dim x, i As Long, d As Object, w, y
Dim PosW As Long, PosY As Long
Set d = CreateObject("scripting.dictionary")
    d.comparemode = 1
With CreateObject("scripting.dictionary")
    .comparemode = 1
    x = Split(r.Value, "/")
    For i = 0 To UBound(x)
        If InStr(1, x(i), "week", 1) Then
            .Item(x(i)) = Empty
        Else
            d.Item(x(i)) = Empty
        End If
    Next
    If .Count Then
        w = Join$(SortCell(.keys, True), "/")
        If d.Count Then
            KARAN = w & "/" & Join$(SortCell(d.keys, False), "/")
        Else
            KARAN = w
        End If
    ElseIf d.Count Then
        KARAN = Join$(SortCell(d.keys, False), "/")
    End If
End With
End Function
Function SortCell(ByRef v, ByVal WeekItIs As Boolean)
    Dim i   As Long, j As Long, t
    Dim x1, x2
    For i = LBound(v) To UBound(v)
        For j = i To UBound(v)
            If WeekItIs Then
                x1 = Replace(Replace(LCase$(v(j)), "weeks", ""), "week", "")
                x2 = Replace(Replace(LCase$(v(i)), "weeks", ""), "week", "")
            Else
                x1 = Replace(Replace(LCase$(v(j)), "years", ""), "year", "")
                x2 = Replace(Replace(LCase$(v(i)), "years", ""), "year", "")
            End If
            If CSng(x1) < CSng(x2) Then
                t = v(i)
                v(i) = v(j)
                v(j) = t
            End If
        Next
    Next
    SortCell = v
End Function

Karan001 · May 17, 2011

Hi Peter,Mick & Krishna,
Really excellent codes given by you all. I checked all the codes & all are working.

Thanks to all of you for giving your continuous support.

Regards
Karan

Accending Order

Karan001

Board Regular

Excel Facts

Jon von der Heyden

MrExcel MVP, Moderator

Karan001

Board Regular

Jon von der Heyden

MrExcel MVP, Moderator

Karan001

Board Regular

Krishnakumar

Well-known Member

Peter_SSs

MrExcel MVP, Moderator

MickG

MrExcel MVP

Krishnakumar

Well-known Member

Karan001

Board Regular

Similar threads

Forum statistics

Share this page

Accending Order

Board Regular

Excel Facts

MrExcel MVP, Moderator

Board Regular

MrExcel MVP, Moderator

Board Regular

Well-known Member

MrExcel MVP, Moderator

MrExcel MVP

Well-known Member

Board Regular

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock