Hi everyone,

I have bunch of codes in this structure:

-'N''A' , where N = Number from 1 to 13, A = Alaphabet H,D,S,C

in each cell, I have 5 of codes above combined together.
e.g. 1D3S4C3D13S


Problem is, those Alphabet codes and numbers have orders.

i.e.
Condition 1. H > D > S > C, if it is bigger, it needs to be positioned
left side.
Condition 2. 1 is the biggest 13 is the smallest same rule applies.

so if I have this code in cell A1 for an example : 5H8C3D1D13S
this should really be arranged as 5H1D3D3S8C because H is the first
priority 5H comes very first, 1D comes before 3D because number 1 is
higher priority than 3 and they came before 3S because of the alphabet
code 'D'.

if I have an empty cell A1 (this is where I will be putting these
5codes in random order), how do i make it arrange it properly and
display in B1 automatically according to those two conditions?


thank you for your help in advance.


regards,

James

You need to program it with VBA, there is no way to do it with Exel itself:
1) read cell (A1) value to VBA
2) cut cell value to pieces (5H, 3D ..)
3) reassemble pieces according to your rules
4) write reassembled value to target cell (B1)



"James8309" wrote:

> Hi everyone,
>
> I have bunch of codes in this structure:
>
> -'N''A' , where N = Number from 1 to 13, A = Alaphabet H,D,S,C
>
> in each cell, I have 5 of codes above combined together.
> e.g. 1D3S4C3D13S
>
>
> Problem is, those Alphabet codes and numbers have orders.
>
> i.e.
> Condition 1. H > D > S > C, if it is bigger, it needs to be positioned
> left side.
> Condition 2. 1 is the biggest 13 is the smallest same rule applies.
>
> so if I have this code in cell A1 for an example : 5H8C3D1D13S
> this should really be arranged as 5H1D3D3S8C because H is the first
> priority 5H comes very first, 1D comes before 3D because number 1 is
> higher priority than 3 and they came before 3S because of the alphabet
> code 'D'.
>
> if I have an empty cell A1 (this is where I will be putting these
> 5codes in random order), how do i make it arrange it properly and
> display in B1 automatically according to those two conditions?
>
>
> thank you for your help in advance.
>
>
> regards,
>
> James
>

Try this USF as a possible solution:

Function ReOrder(origstr)
Dim strarr(4)
Dim weightarr(4)
Dim resultarr(4)
codepos = 1
For i = 1 To 5
strchr = Mid(origstr, codepos, 2)
If Right(strchr, 1) >= "0" And Right(strchr, 1) <= "9" Then _
strchr = Mid(origstr, codepos, 31)
codepos = codepos + Len(strchr)
strarr(i - 1) = strchr
letter = Right(strchr, 1)
weightarr(i - 1) = Val(Left(strchr, Len(strchr) - 1)) + _
100 * IIf(letter = "H", 1, IIf(letter = "D", 2, IIf(letter =
"S", 3, 4)))
Next i
For i = 1 To 5
arrmin = WorksheetFunction.Min(weightarr)
minpos = WorksheetFunction.Match(arrmin, weightarr, 0)
resultarr(i - 1) = strarr(minpos - 1)
weightarr(minpos - 1) = 1000
Next i
ReOrder = Join(resultarr, "")
End Function

Sub test()
x = ReOrder(Range("A1"))
End Sub

Regards,
Stefi


„James8309â€� ezt Ã*rta:

> Hi everyone,
>
> I have bunch of codes in this structure:
>
> -'N''A' , where N = Number from 1 to 13, A = Alaphabet H,D,S,C
>
> in each cell, I have 5 of codes above combined together.
> e.g. 1D3S4C3D13S
>
>
> Problem is, those Alphabet codes and numbers have orders.
>
> i.e.
> Condition 1. H > D > S > C, if it is bigger, it needs to be positioned
> left side.
> Condition 2. 1 is the biggest 13 is the smallest same rule applies.
>
> so if I have this code in cell A1 for an example : 5H8C3D1D13S
> this should really be arranged as 5H1D3D3S8C because H is the first
> priority 5H comes very first, 1D comes before 3D because number 1 is
> higher priority than 3 and they came before 3S because of the alphabet
> code 'D'.
>
> if I have an empty cell A1 (this is where I will be putting these
> 5codes in random order), how do i make it arrange it properly and
> display in B1 automatically according to those two conditions?
>
>
> thank you for your help in advance.
>
>
> regards,
>
> James
>

The previous solution only parses the string in twos therfore will fail if
the code number starts with for example 13C
I would suggest the following adaptation:

Sub test()

Dim tbl2 As Variant
Dim j As Long

tbl2 = range(Cells(1, 1), Cells(Cells(Rows.Count, "A").End(xlUp).Row, 1))

For j = LBound(tbl2, 1) To UBound(tbl2, 1)
If Not tbl2(j, 1) = "" Then tbl2(j, 1) = ReOrder(tbl2(j, 1))
Next j
range(Cells(1, 2), Cells(Cells(Rows.Count, "A").End(xlUp).Row, 2)) = tbl2

End Sub

Function ReOrder(origstr) As String

Dim strarr(4)
Dim weightarr(4)
Dim resultarr(4)
Dim codepos As Long
Dim strchr As String
Dim i As Long, j As Long
Dim letter As String
Dim arrmin As Long
Dim minpos As Long
Dim sChar As String
Dim sStr(4)

i = 0
For j = 0 To 4
For i = i + 1 To Len(origstr)
sChar = Mid(origstr, i, 1)
If sChar Like "*[HDSC]*" Then
sStr(j) = sStr(j) & sChar
Exit For
End If
If Not sChar Like "*[!0-9]*" Then sStr(j) = sStr(j) & sChar
Next i
Next j

codepos = 1
j = 0

For i = 1 To 5
strchr = sStr(j)
codepos = codepos + Len(strchr)
strarr(i - 1) = strchr
letter = Right(strchr, 1)
weightarr(i - 1) = Val(Left(strchr, Len(strchr) - 1)) + _
100 * IIf(letter = "H", 1, IIf(letter = "D", 2,
IIf(letter = "S", 3, 4)))
j = j + 1
Next i

For i = 1 To 5
arrmin = WorksheetFunction.Min(weightarr)
minpos = WorksheetFunction.Match(arrmin, weightarr, 0)
resultarr(i - 1) = strarr(minpos - 1)
weightarr(minpos - 1) = 1000
Next i

ReOrder = Join(resultarr, "")

End Function

hth

Geoff

"Stefi" wrote:

> Try this USF as a possible solution:
>
> Function ReOrder(origstr)
> Dim strarr(4)
> Dim weightarr(4)
> Dim resultarr(4)
> codepos = 1
> For i = 1 To 5
> strchr = Mid(origstr, codepos, 2)
> If Right(strchr, 1) >= "0" And Right(strchr, 1) <= "9" Then _
> strchr = Mid(origstr, codepos, 31)
> codepos = codepos + Len(strchr)
> strarr(i - 1) = strchr
> letter = Right(strchr, 1)
> weightarr(i - 1) = Val(Left(strchr, Len(strchr) - 1)) + _
> 100 * IIf(letter = "H", 1, IIf(letter = "D", 2, IIf(letter =
> "S", 3, 4)))
> Next i
> For i = 1 To 5
> arrmin = WorksheetFunction.Min(weightarr)
> minpos = WorksheetFunction.Match(arrmin, weightarr, 0)
> resultarr(i - 1) = strarr(minpos - 1)
> weightarr(minpos - 1) = 1000
> Next i
> ReOrder = Join(resultarr, "")
> End Function
>
> Sub test()
> x = ReOrder(Range("A1"))
> End Sub
>
> Regards,
> Stefi
>
>
> „James8309â€� ezt Ã*rta:
>
> > Hi everyone,
> >
> > I have bunch of codes in this structure:
> >
> > -'N''A' , where N = Number from 1 to 13, A = Alaphabet H,D,S,C
> >
> > in each cell, I have 5 of codes above combined together.
> > e.g. 1D3S4C3D13S
> >
> >
> > Problem is, those Alphabet codes and numbers have orders.
> >
> > i.e.
> > Condition 1. H > D > S > C, if it is bigger, it needs to be positioned
> > left side.
> > Condition 2. 1 is the biggest 13 is the smallest same rule applies.
> >
> > so if I have this code in cell A1 for an example : 5H8C3D1D13S
> > this should really be arranged as 5H1D3D3S8C because H is the first
> > priority 5H comes very first, 1D comes before 3D because number 1 is
> > higher priority than 3 and they came before 3S because of the alphabet
> > code 'D'.
> >
> > if I have an empty cell A1 (this is where I will be putting these
> > 5codes in random order), how do i make it arrange it properly and
> > display in B1 automatically according to those two conditions?
> >
> >
> > thank you for your help in advance.
> >
> >
> > regards,
> >
> > James
> >

Hi Geoff,

I tested again my function and found a typo in it indeed:
If Right(strchr, 1) >= "0" And Right(strchr, 1) <= "9" Then _
strchr = Mid(origstr, codepos, 31)
is wrong, the correct line is
If Right(strchr, 1) >= "0" And Right(strchr, 1) <= "9" Then _
strchr = Mid(origstr, codepos, 3)

With this correction the function deals with strings starting by 13S as well.

Thanks for your contribution!

Regards,
Stefi

„Geoffâ€� ezt Ã*rta:

> The previous solution only parses the string in twos therfore will fail if
> the code number starts with for example 13C
> I would suggest the following adaptation:
>
> Sub test()
>
> Dim tbl2 As Variant
> Dim j As Long
>
> tbl2 = range(Cells(1, 1), Cells(Cells(Rows.Count, "A").End(xlUp).Row, 1))
>
> For j = LBound(tbl2, 1) To UBound(tbl2, 1)
> If Not tbl2(j, 1) = "" Then tbl2(j, 1) = ReOrder(tbl2(j, 1))
> Next j
> range(Cells(1, 2), Cells(Cells(Rows.Count, "A").End(xlUp).Row, 2)) = tbl2
>
> End Sub
>
> Function ReOrder(origstr) As String
>
> Dim strarr(4)
> Dim weightarr(4)
> Dim resultarr(4)
> Dim codepos As Long
> Dim strchr As String
> Dim i As Long, j As Long
> Dim letter As String
> Dim arrmin As Long
> Dim minpos As Long
> Dim sChar As String
> Dim sStr(4)
>
> i = 0
> For j = 0 To 4
> For i = i + 1 To Len(origstr)
> sChar = Mid(origstr, i, 1)
> If sChar Like "*[HDSC]*" Then
> sStr(j) = sStr(j) & sChar
> Exit For
> End If
> If Not sChar Like "*[!0-9]*" Then sStr(j) = sStr(j) & sChar
> Next i
> Next j
>
> codepos = 1
> j = 0
>
> For i = 1 To 5
> strchr = sStr(j)
> codepos = codepos + Len(strchr)
> strarr(i - 1) = strchr
> letter = Right(strchr, 1)
> weightarr(i - 1) = Val(Left(strchr, Len(strchr) - 1)) + _
> 100 * IIf(letter = "H", 1, IIf(letter = "D", 2,
> IIf(letter = "S", 3, 4)))
> j = j + 1
> Next i
>
> For i = 1 To 5
> arrmin = WorksheetFunction.Min(weightarr)
> minpos = WorksheetFunction.Match(arrmin, weightarr, 0)
> resultarr(i - 1) = strarr(minpos - 1)
> weightarr(minpos - 1) = 1000
> Next i
>
> ReOrder = Join(resultarr, "")
>
> End Function
>
> hth
>
> Geoff
>
> "Stefi" wrote:
>
> > Try this USF as a possible solution:
> >
> > Function ReOrder(origstr)
> > Dim strarr(4)
> > Dim weightarr(4)
> > Dim resultarr(4)
> > codepos = 1
> > For i = 1 To 5
> > strchr = Mid(origstr, codepos, 2)
> > If Right(strchr, 1) >= "0" And Right(strchr, 1) <= "9" Then _
> > strchr = Mid(origstr, codepos, 31)
> > codepos = codepos + Len(strchr)
> > strarr(i - 1) = strchr
> > letter = Right(strchr, 1)
> > weightarr(i - 1) = Val(Left(strchr, Len(strchr) - 1)) + _
> > 100 * IIf(letter = "H", 1, IIf(letter = "D", 2, IIf(letter =
> > "S", 3, 4)))
> > Next i
> > For i = 1 To 5
> > arrmin = WorksheetFunction.Min(weightarr)
> > minpos = WorksheetFunction.Match(arrmin, weightarr, 0)
> > resultarr(i - 1) = strarr(minpos - 1)
> > weightarr(minpos - 1) = 1000
> > Next i
> > ReOrder = Join(resultarr, "")
> > End Function
> >
> > Sub test()
> > x = ReOrder(Range("A1"))
> > End Sub
> >
> > Regards,
> > Stefi
> >
> >
> > „James8309â€� ezt Ã*rta:
> >
> > > Hi everyone,
> > >
> > > I have bunch of codes in this structure:
> > >
> > > -'N''A' , where N = Number from 1 to 13, A = Alaphabet H,D,S,C
> > >
> > > in each cell, I have 5 of codes above combined together.
> > > e.g. 1D3S4C3D13S
> > >
> > >
> > > Problem is, those Alphabet codes and numbers have orders.
> > >
> > > i.e.
> > > Condition 1. H > D > S > C, if it is bigger, it needs to be positioned
> > > left side.
> > > Condition 2. 1 is the biggest 13 is the smallest same rule applies.
> > >
> > > so if I have this code in cell A1 for an example : 5H8C3D1D13S
> > > this should really be arranged as 5H1D3D3S8C because H is the first
> > > priority 5H comes very first, 1D comes before 3D because number 1 is
> > > higher priority than 3 and they came before 3S because of the alphabet
> > > code 'D'.
> > >
> > > if I have an empty cell A1 (this is where I will be putting these
> > > 5codes in random order), how do i make it arrange it properly and
> > > display in B1 automatically according to those two conditions?
> > >
> > >
> > > thank you for your help in advance.
> > >
> > >
> > > regards,
> > >
> > > James
> > >

Hi Stefi

Indeed it does - and less verbose too <g>

Geoff

"Stefi" wrote:

> Hi Geoff,
>
> I tested again my function and found a typo in it indeed:
> If Right(strchr, 1) >= "0" And Right(strchr, 1) <= "9" Then _
> strchr = Mid(origstr, codepos, 31)
> is wrong, the correct line is
> If Right(strchr, 1) >= "0" And Right(strchr, 1) <= "9" Then _
> strchr = Mid(origstr, codepos, 3)
>
> With this correction the function deals with strings starting by 13S as well.
>
> Thanks for your contribution!
>
> Regards,
> Stefi
>
> „Geoffâ€� ezt Ã*rta:
>
> > The previous solution only parses the string in twos therfore will fail if
> > the code number starts with for example 13C
> > I would suggest the following adaptation:
> >
> > Sub test()
> >
> > Dim tbl2 As Variant
> > Dim j As Long
> >
> > tbl2 = range(Cells(1, 1), Cells(Cells(Rows.Count, "A").End(xlUp).Row, 1))
> >
> > For j = LBound(tbl2, 1) To UBound(tbl2, 1)
> > If Not tbl2(j, 1) = "" Then tbl2(j, 1) = ReOrder(tbl2(j, 1))
> > Next j
> > range(Cells(1, 2), Cells(Cells(Rows.Count, "A").End(xlUp).Row, 2)) = tbl2
> >
> > End Sub
> >
> > Function ReOrder(origstr) As String
> >
> > Dim strarr(4)
> > Dim weightarr(4)
> > Dim resultarr(4)
> > Dim codepos As Long
> > Dim strchr As String
> > Dim i As Long, j As Long
> > Dim letter As String
> > Dim arrmin As Long
> > Dim minpos As Long
> > Dim sChar As String
> > Dim sStr(4)
> >
> > i = 0
> > For j = 0 To 4
> > For i = i + 1 To Len(origstr)
> > sChar = Mid(origstr, i, 1)
> > If sChar Like "*[HDSC]*" Then
> > sStr(j) = sStr(j) & sChar
> > Exit For
> > End If
> > If Not sChar Like "*[!0-9]*" Then sStr(j) = sStr(j) & sChar
> > Next i
> > Next j
> >
> > codepos = 1
> > j = 0
> >
> > For i = 1 To 5
> > strchr = sStr(j)
> > codepos = codepos + Len(strchr)
> > strarr(i - 1) = strchr
> > letter = Right(strchr, 1)
> > weightarr(i - 1) = Val(Left(strchr, Len(strchr) - 1)) + _
> > 100 * IIf(letter = "H", 1, IIf(letter = "D", 2,
> > IIf(letter = "S", 3, 4)))
> > j = j + 1
> > Next i
> >
> > For i = 1 To 5
> > arrmin = WorksheetFunction.Min(weightarr)
> > minpos = WorksheetFunction.Match(arrmin, weightarr, 0)
> > resultarr(i - 1) = strarr(minpos - 1)
> > weightarr(minpos - 1) = 1000
> > Next i
> >
> > ReOrder = Join(resultarr, "")
> >
> > End Function
> >
> > hth
> >
> > Geoff
> >
> > "Stefi" wrote:
> >
> > > Try this USF as a possible solution:
> > >
> > > Function ReOrder(origstr)
> > > Dim strarr(4)
> > > Dim weightarr(4)
> > > Dim resultarr(4)
> > > codepos = 1
> > > For i = 1 To 5
> > > strchr = Mid(origstr, codepos, 2)
> > > If Right(strchr, 1) >= "0" And Right(strchr, 1) <= "9" Then _
> > > strchr = Mid(origstr, codepos, 31)
> > > codepos = codepos + Len(strchr)
> > > strarr(i - 1) = strchr
> > > letter = Right(strchr, 1)
> > > weightarr(i - 1) = Val(Left(strchr, Len(strchr) - 1)) + _
> > > 100 * IIf(letter = "H", 1, IIf(letter = "D", 2, IIf(letter =
> > > "S", 3, 4)))
> > > Next i
> > > For i = 1 To 5
> > > arrmin = WorksheetFunction.Min(weightarr)
> > > minpos = WorksheetFunction.Match(arrmin, weightarr, 0)
> > > resultarr(i - 1) = strarr(minpos - 1)
> > > weightarr(minpos - 1) = 1000
> > > Next i
> > > ReOrder = Join(resultarr, "")
> > > End Function
> > >
> > > Sub test()
> > > x = ReOrder(Range("A1"))
> > > End Sub
> > >
> > > Regards,
> > > Stefi
> > >
> > >
> > > „James8309â€� ezt Ã*rta:
> > >
> > > > Hi everyone,
> > > >
> > > > I have bunch of codes in this structure:
> > > >
> > > > -'N''A' , where N = Number from 1 to 13, A = Alaphabet H,D,S,C
> > > >
> > > > in each cell, I have 5 of codes above combined together.
> > > > e.g. 1D3S4C3D13S
> > > >
> > > >
> > > > Problem is, those Alphabet codes and numbers have orders.
> > > >
> > > > i.e.
> > > > Condition 1. H > D > S > C, if it is bigger, it needs to be positioned
> > > > left side.
> > > > Condition 2. 1 is the biggest 13 is the smallest same rule applies.
> > > >
> > > > so if I have this code in cell A1 for an example : 5H8C3D1D13S
> > > > this should really be arranged as 5H1D3D3S8C because H is the first
> > > > priority 5H comes very first, 1D comes before 3D because number 1 is
> > > > higher priority than 3 and they came before 3S because of the alphabet
> > > > code 'D'.
> > > >
> > > > if I have an empty cell A1 (this is where I will be putting these
> > > > 5codes in random order), how do i make it arrange it properly and
> > > > display in B1 automatically according to those two conditions?
> > > >
> > > >
> > > > thank you for your help in advance.
> > > >
> > > >
> > > > regards,
> > > >
> > > > James
> > > >

It depends on the aim of the post: it may focus either to solve the problem
or explain the details of the solution to the requester.

Stefi


„Geoffâ€� ezt Ã*rta:

> Hi Stefi
>
> Indeed it does - and less verbose too <g>
>
> Geoff
>
> "Stefi" wrote:
>
> > Hi Geoff,
> >
> > I tested again my function and found a typo in it indeed:
> > If Right(strchr, 1) >= "0" And Right(strchr, 1) <= "9" Then _
> > strchr = Mid(origstr, codepos, 31)
> > is wrong, the correct line is
> > If Right(strchr, 1) >= "0" And Right(strchr, 1) <= "9" Then _
> > strchr = Mid(origstr, codepos, 3)
> >
> > With this correction the function deals with strings starting by 13S as well.
> >
> > Thanks for your contribution!
> >
> > Regards,
> > Stefi
> >
> > „Geoffâ€� ezt Ã*rta:
> >
> > > The previous solution only parses the string in twos therfore will fail if
> > > the code number starts with for example 13C
> > > I would suggest the following adaptation:
> > >
> > > Sub test()
> > >
> > > Dim tbl2 As Variant
> > > Dim j As Long
> > >
> > > tbl2 = range(Cells(1, 1), Cells(Cells(Rows.Count, "A").End(xlUp).Row, 1))
> > >
> > > For j = LBound(tbl2, 1) To UBound(tbl2, 1)
> > > If Not tbl2(j, 1) = "" Then tbl2(j, 1) = ReOrder(tbl2(j, 1))
> > > Next j
> > > range(Cells(1, 2), Cells(Cells(Rows.Count, "A").End(xlUp).Row, 2)) = tbl2
> > >
> > > End Sub
> > >
> > > Function ReOrder(origstr) As String
> > >
> > > Dim strarr(4)
> > > Dim weightarr(4)
> > > Dim resultarr(4)
> > > Dim codepos As Long
> > > Dim strchr As String
> > > Dim i As Long, j As Long
> > > Dim letter As String
> > > Dim arrmin As Long
> > > Dim minpos As Long
> > > Dim sChar As String
> > > Dim sStr(4)
> > >
> > > i = 0
> > > For j = 0 To 4
> > > For i = i + 1 To Len(origstr)
> > > sChar = Mid(origstr, i, 1)
> > > If sChar Like "*[HDSC]*" Then
> > > sStr(j) = sStr(j) & sChar
> > > Exit For
> > > End If
> > > If Not sChar Like "*[!0-9]*" Then sStr(j) = sStr(j) & sChar
> > > Next i
> > > Next j
> > >
> > > codepos = 1
> > > j = 0
> > >
> > > For i = 1 To 5
> > > strchr = sStr(j)
> > > codepos = codepos + Len(strchr)
> > > strarr(i - 1) = strchr
> > > letter = Right(strchr, 1)
> > > weightarr(i - 1) = Val(Left(strchr, Len(strchr) - 1)) + _
> > > 100 * IIf(letter = "H", 1, IIf(letter = "D", 2,
> > > IIf(letter = "S", 3, 4)))
> > > j = j + 1
> > > Next i
> > >
> > > For i = 1 To 5
> > > arrmin = WorksheetFunction.Min(weightarr)
> > > minpos = WorksheetFunction.Match(arrmin, weightarr, 0)
> > > resultarr(i - 1) = strarr(minpos - 1)
> > > weightarr(minpos - 1) = 1000
> > > Next i
> > >
> > > ReOrder = Join(resultarr, "")
> > >
> > > End Function
> > >
> > > hth
> > >
> > > Geoff
> > >
> > > "Stefi" wrote:
> > >
> > > > Try this USF as a possible solution:
> > > >
> > > > Function ReOrder(origstr)
> > > > Dim strarr(4)
> > > > Dim weightarr(4)
> > > > Dim resultarr(4)
> > > > codepos = 1
> > > > For i = 1 To 5
> > > > strchr = Mid(origstr, codepos, 2)
> > > > If Right(strchr, 1) >= "0" And Right(strchr, 1) <= "9" Then _
> > > > strchr = Mid(origstr, codepos, 31)
> > > > codepos = codepos + Len(strchr)
> > > > strarr(i - 1) = strchr
> > > > letter = Right(strchr, 1)
> > > > weightarr(i - 1) = Val(Left(strchr, Len(strchr) - 1)) + _
> > > > 100 * IIf(letter = "H", 1, IIf(letter = "D", 2, IIf(letter =
> > > > "S", 3, 4)))
> > > > Next i
> > > > For i = 1 To 5
> > > > arrmin = WorksheetFunction.Min(weightarr)
> > > > minpos = WorksheetFunction.Match(arrmin, weightarr, 0)
> > > > resultarr(i - 1) = strarr(minpos - 1)
> > > > weightarr(minpos - 1) = 1000
> > > > Next i
> > > > ReOrder = Join(resultarr, "")
> > > > End Function
> > > >
> > > > Sub test()
> > > > x = ReOrder(Range("A1"))
> > > > End Sub
> > > >
> > > > Regards,
> > > > Stefi
> > > >
> > > >
> > > > „James8309â€� ezt Ã*rta:
> > > >
> > > > > Hi everyone,
> > > > >
> > > > > I have bunch of codes in this structure:
> > > > >
> > > > > -'N''A' , where N = Number from 1 to 13, A = Alaphabet H,D,S,C
> > > > >
> > > > > in each cell, I have 5 of codes above combined together.
> > > > > e.g. 1D3S4C3D13S
> > > > >
> > > > >
> > > > > Problem is, those Alphabet codes and numbers have orders.
> > > > >
> > > > > i.e.
> > > > > Condition 1. H > D > S > C, if it is bigger, it needs to be positioned
> > > > > left side.
> > > > > Condition 2. 1 is the biggest 13 is the smallest same rule applies.
> > > > >
> > > > > so if I have this code in cell A1 for an example : 5H8C3D1D13S
> > > > > this should really be arranged as 5H1D3D3S8C because H is the first
> > > > > priority 5H comes very first, 1D comes before 3D because number 1 is
> > > > > higher priority than 3 and they came before 3S because of the alphabet
> > > > > code 'D'.
> > > > >
> > > > > if I have an empty cell A1 (this is where I will be putting these
> > > > > 5codes in random order), how do i make it arrange it properly and
> > > > > display in B1 automatically according to those two conditions?
> > > > >
> > > > >
> > > > > thank you for your help in advance.
> > > > >
> > > > >
> > > > > regards,
> > > > >
> > > > > James
> > > > >

On Jul 1, 11:26*pm, Stefi <St...@discussions.microsoft.com> wrote:
> It depends on the aim of the post: it may focus either to solve the problem
> or explain the details of the solution to the requester.
>
> Stefi
>
> „Geoff” ezt írta:
>
>
>
> > Hi Stefi
>
> > Indeed it does - and less verbose too <g>
>
> > Geoff
>
> > "Stefi" wrote:
>
> > > Hi Geoff,
>
> > > I tested again my function and found a typo in it indeed:
> > > *If Right(strchr, 1) >= "0" And Right(strchr, 1) <= "9" Then _
> > > * * *strchr = Mid(origstr, codepos, 31)
> > > is wrong, the correct line is
> > > If Right(strchr, 1) >= "0" And Right(strchr, 1) <= "9" Then _
> > > * * strchr = Mid(origstr, codepos, 3)
>
> > > With this correction the function deals with strings starting by 13S as well.
>
> > > Thanks for your contribution!
>
> > > Regards,
> > > Stefi
>
> > > „Geoff” ezt írta:
>
> > > > The previous solution only parses the string in twos therfore will fail if
> > > > the code number starts with for example 13C
> > > > I would suggest the following adaptation:
>
> > > > Sub test()
>
> > > > * *Dim tbl2 As Variant
> > > > * *Dim j As Long
>
> > > > * *tbl2 = range(Cells(1, 1), Cells(Cells(Rows.Count, "A").End(xlUp).Row, 1))
>
> > > > * *For j = LBound(tbl2, 1) To UBound(tbl2, 1)
> > > > * * * If Not tbl2(j, 1) = "" Then tbl2(j, 1) = ReOrder(tbl2(j, 1))
> > > > * *Next j
> > > > * *range(Cells(1, 2), Cells(Cells(Rows.Count, "A").End(xlUp).Row, 2)) = tbl2
>
> > > > End Sub
>
> > > > Function ReOrder(origstr) As String
>
> > > > * * Dim strarr(4)
> > > > * * Dim weightarr(4)
> > > > * * Dim resultarr(4)
> > > > * * Dim codepos As Long
> > > > * * Dim strchr As String
> > > > * * Dim i As Long, j As Long
> > > > * * Dim letter As String
> > > > * * Dim arrmin As Long
> > > > * * Dim minpos As Long
> > > > * * Dim sChar As String
> > > > * * Dim sStr(4)
>
> > > > * * i = 0
> > > > * * For j = 0 To 4
> > > > * * * * For i = i + 1 To Len(origstr)
> > > > * * * * * * sChar = Mid(origstr, i, 1)
> > > > * * * * * * If sChar Like "*[HDSC]*" Then
> > > > * * * * * * * * sStr(j) = sStr(j) & sChar
> > > > * * * * * * * * Exit For
> > > > * * * * * * End If
> > > > * * * * * * If Not sChar Like "*[!0-9]*" Then sStr(j) = sStr(j) & sChar
> > > > * * * * Next i
> > > > * * Next j
>
> > > > * * codepos = 1
> > > > * * j = 0
>
> > > > * * For i = 1 To 5
> > > > * * * * strchr = sStr(j)
> > > > * * * * codepos = codepos + Len(strchr)
> > > > * * * * strarr(i - 1) = strchr
> > > > * * * * letter = Right(strchr, 1)
> > > > * * * * weightarr(i - 1) = Val(Left(strchr, Len(strchr) - 1)) + _
> > > > * * * * * * * * * * * * * *100 * IIf(letter = "H", 1, IIf(letter = "D", 2,
> > > > IIf(letter = "S", 3, 4)))
> > > > * * * * j = j + 1
> > > > * * Next i
>
> > > > * * For i = 1 To 5
> > > > * * * * arrmin = WorksheetFunction.Min(weightarr)
> > > > * * * * minpos = WorksheetFunction.Match(arrmin, weightarr, 0)
> > > > * * * * resultarr(i - 1) = strarr(minpos - 1)
> > > > * * * * weightarr(minpos - 1) = 1000
> > > > * * Next i
>
> > > > * * ReOrder = Join(resultarr, "")
>
> > > > End Function
>
> > > > hth
>
> > > > Geoff
>
> > > > "Stefi" wrote:
>
> > > > > Try this USF as a possible solution:
>
> > > > > Function ReOrder(origstr)
> > > > > * * Dim strarr(4)
> > > > > * * Dim weightarr(4)
> > > > > * * Dim resultarr(4)
> > > > > * * codepos = 1
> > > > > * * For i = 1 To 5
> > > > > * * * * strchr = Mid(origstr, codepos, 2)
> > > > > * * * * If Right(strchr, 1) >= "0" And Right(strchr, 1) <= "9" Then _
> > > > > * * * * * * strchr = Mid(origstr, codepos, 31)
> > > > > * * * * codepos = codepos + Len(strchr)
> > > > > * * * * strarr(i - 1) = strchr
> > > > > * * * * letter = Right(strchr, 1)
> > > > > * * * * weightarr(i - 1) = Val(Left(strchr, Len(strchr) - 1)) + _
> > > > > * * * * * * 100 * IIf(letter = "H", 1, IIf(letter = "D", 2, IIf(letter =
> > > > > "S", 3, 4)))
> > > > > * * Next i
> > > > > * * For i = 1 To 5
> > > > > * * * * arrmin = WorksheetFunction.Min(weightarr)
> > > > > * * * * minpos = WorksheetFunction.Match(arrmin, weightarr, 0)
> > > > > * * * * resultarr(i - 1) = strarr(minpos - 1)
> > > > > * * * * weightarr(minpos - 1) = 1000
> > > > > * * Next i
> > > > > * * ReOrder = Join(resultarr, "")
> > > > > End Function
>
> > > > > Sub test()
> > > > > * * x = ReOrder(Range("A1"))
> > > > > End Sub
>
> > > > > Regards,
> > > > > Stefi
>
> > > > > „James8309” ezt írta:
>
> > > > > > Hi everyone,
>
> > > > > > I have bunch of codes in this structure:
>
> > > > > > -'N''A' , where N = Number from 1 to 13, *A = Alaphabet H,D,S,C
>
> > > > > > in each cell, I have 5 of codes above combined together.
> > > > > > e.g. 1D3S4C3D13S
>
> > > > > > Problem is, those Alphabet codes and numbers have orders.
>
> > > > > > i.e.
> > > > > > Condition 1. H > D > S > C, if it is bigger, it needs to be positioned
> > > > > > left side.
> > > > > > Condition 2. 1 is the biggest 13 is the smallest same rule applies.
>
> > > > > > so if I have this code in cell A1 for an example : 5H8C3D1D13S
> > > > > > this should really be arranged as 5H1D3D3S8C because H is the first
> > > > > > priority 5H comes very first, 1D comes before 3D because number 1 is
> > > > > > higher priority than 3 and they came before 3S because of the alphabet
> > > > > > code 'D'.
>
> > > > > > if I have an empty cell A1 (this is where I will be putting these
> > > > > > 5codes in random order), how do i make it arrange it properly and
> > > > > > display in B1 automatically according to those two conditions?
>
> > > > > > thank you for your help in advance.
>
> > > > > > regards,
>
> > > > > > James- Hide quoted text -
>
> - Show quoted text -

Hi Stefi,

Thank you for your help. I just copied the code that you posted into
VBA tab and when I run it, it doesn't do anything?
Could you please tell me what I am doing wrong?

Thanks again.

First you have to make sure you placed the code (fixed version) into a normal
module. VBA>Project explorer>Right click on
VBAproject(yourfilename)>Insert>Module>Paste here the code

Usage:

If your original code is in A1, then enter in B1
=ReOrder(A1)
It should return the reordered code.

Regards,
Stefi




„James8309â€� ezt Ã*rta:

> On Jul 1, 11:26 pm, Stefi <St...@discussions.microsoft.com> wrote:
> > It depends on the aim of the post: it may focus either to solve the problem
> > or explain the details of the solution to the requester.
> >
> > Stefi
> >
> > „Geoffâ€� ezt Ã*rta:
> >
> >
> >
> > > Hi Stefi
> >
> > > Indeed it does - and less verbose too <g>
> >
> > > Geoff
> >
> > > "Stefi" wrote:
> >
> > > > Hi Geoff,
> >
> > > > I tested again my function and found a typo in it indeed:
> > > > If Right(strchr, 1) >= "0" And Right(strchr, 1) <= "9" Then _
> > > > strchr = Mid(origstr, codepos, 31)
> > > > is wrong, the correct line is
> > > > If Right(strchr, 1) >= "0" And Right(strchr, 1) <= "9" Then _
> > > > strchr = Mid(origstr, codepos, 3)
> >
> > > > With this correction the function deals with strings starting by 13S as well.
> >
> > > > Thanks for your contribution!
> >
> > > > Regards,
> > > > Stefi
> >
> > > > „Geoffâ€� ezt Ã*rta:
> >
> > > > > The previous solution only parses the string in twos therfore will fail if
> > > > > the code number starts with for example 13C
> > > > > I would suggest the following adaptation:
> >
> > > > > Sub test()
> >
> > > > > Dim tbl2 As Variant
> > > > > Dim j As Long
> >
> > > > > tbl2 = range(Cells(1, 1), Cells(Cells(Rows.Count, "A").End(xlUp).Row, 1))
> >
> > > > > For j = LBound(tbl2, 1) To UBound(tbl2, 1)
> > > > > If Not tbl2(j, 1) = "" Then tbl2(j, 1) = ReOrder(tbl2(j, 1))
> > > > > Next j
> > > > > range(Cells(1, 2), Cells(Cells(Rows.Count, "A").End(xlUp).Row, 2)) = tbl2
> >
> > > > > End Sub
> >
> > > > > Function ReOrder(origstr) As String
> >
> > > > > Dim strarr(4)
> > > > > Dim weightarr(4)
> > > > > Dim resultarr(4)
> > > > > Dim codepos As Long
> > > > > Dim strchr As String
> > > > > Dim i As Long, j As Long
> > > > > Dim letter As String
> > > > > Dim arrmin As Long
> > > > > Dim minpos As Long
> > > > > Dim sChar As String
> > > > > Dim sStr(4)
> >
> > > > > i = 0
> > > > > For j = 0 To 4
> > > > > For i = i + 1 To Len(origstr)
> > > > > sChar = Mid(origstr, i, 1)
> > > > > If sChar Like "*[HDSC]*" Then
> > > > > sStr(j) = sStr(j) & sChar
> > > > > Exit For
> > > > > End If
> > > > > If Not sChar Like "*[!0-9]*" Then sStr(j) = sStr(j) & sChar
> > > > > Next i
> > > > > Next j
> >
> > > > > codepos = 1
> > > > > j = 0
> >
> > > > > For i = 1 To 5
> > > > > strchr = sStr(j)
> > > > > codepos = codepos + Len(strchr)
> > > > > strarr(i - 1) = strchr
> > > > > letter = Right(strchr, 1)
> > > > > weightarr(i - 1) = Val(Left(strchr, Len(strchr) - 1)) + _
> > > > > 100 * IIf(letter = "H", 1, IIf(letter = "D", 2,
> > > > > IIf(letter = "S", 3, 4)))
> > > > > j = j + 1
> > > > > Next i
> >
> > > > > For i = 1 To 5
> > > > > arrmin = WorksheetFunction.Min(weightarr)
> > > > > minpos = WorksheetFunction.Match(arrmin, weightarr, 0)
> > > > > resultarr(i - 1) = strarr(minpos - 1)
> > > > > weightarr(minpos - 1) = 1000
> > > > > Next i
> >
> > > > > ReOrder = Join(resultarr, "")
> >
> > > > > End Function
> >
> > > > > hth
> >
> > > > > Geoff
> >
> > > > > "Stefi" wrote:
> >
> > > > > > Try this USF as a possible solution:
> >
> > > > > > Function ReOrder(origstr)
> > > > > > Dim strarr(4)
> > > > > > Dim weightarr(4)
> > > > > > Dim resultarr(4)
> > > > > > codepos = 1
> > > > > > For i = 1 To 5
> > > > > > strchr = Mid(origstr, codepos, 2)
> > > > > > If Right(strchr, 1) >= "0" And Right(strchr, 1) <= "9" Then _
> > > > > > strchr = Mid(origstr, codepos, 31)
> > > > > > codepos = codepos + Len(strchr)
> > > > > > strarr(i - 1) = strchr
> > > > > > letter = Right(strchr, 1)
> > > > > > weightarr(i - 1) = Val(Left(strchr, Len(strchr) - 1)) + _
> > > > > > 100 * IIf(letter = "H", 1, IIf(letter = "D", 2, IIf(letter =
> > > > > > "S", 3, 4)))
> > > > > > Next i
> > > > > > For i = 1 To 5
> > > > > > arrmin = WorksheetFunction.Min(weightarr)
> > > > > > minpos = WorksheetFunction.Match(arrmin, weightarr, 0)
> > > > > > resultarr(i - 1) = strarr(minpos - 1)
> > > > > > weightarr(minpos - 1) = 1000
> > > > > > Next i
> > > > > > ReOrder = Join(resultarr, "")
> > > > > > End Function
> >
> > > > > > Sub test()
> > > > > > x = ReOrder(Range("A1"))
> > > > > > End Sub
> >
> > > > > > Regards,
> > > > > > Stefi
> >
> > > > > > „James8309â€� ezt Ã*rta:
> >
> > > > > > > Hi everyone,
> >
> > > > > > > I have bunch of codes in this structure:
> >
> > > > > > > -'N''A' , where N = Number from 1 to 13, A = Alaphabet H,D,S,C
> >
> > > > > > > in each cell, I have 5 of codes above combined together.
> > > > > > > e.g. 1D3S4C3D13S
> >
> > > > > > > Problem is, those Alphabet codes and numbers have orders.
> >
> > > > > > > i.e.
> > > > > > > Condition 1. H > D > S > C, if it is bigger, it needs to be positioned
> > > > > > > left side.
> > > > > > > Condition 2. 1 is the biggest 13 is the smallest same rule applies.
> >
> > > > > > > so if I have this code in cell A1 for an example : 5H8C3D1D13S
> > > > > > > this should really be arranged as 5H1D3D3S8C because H is the first
> > > > > > > priority 5H comes very first, 1D comes before 3D because number 1 is
> > > > > > > higher priority than 3 and they came before 3S because of the alphabet
> > > > > > > code 'D'.
> >
> > > > > > > if I have an empty cell A1 (this is where I will be putting these
> > > > > > > 5codes in random order), how do i make it arrange it properly and
> > > > > > > display in B1 automatically according to those two conditions?
> >
> > > > > > > thank you for your help in advance.
> >
> > > > > > > regards,
> >
> > > > > > > James- Hide quoted text -
> >
> > - Show quoted text -
>
> Hi Stefi,
>
> Thank you for your help. I just copied the code that you posted into
> VBA tab and when I run it, it doesn't do anything?
> Could you please tell me what I am doing wrong?
>
> Thanks again.
>

Hi Dana,
It's a nice, compact solution, I tried it and it gave the required result,
but I couldn't figure out the logic. Please explain it!
Stefi


„Dana DeLouisâ€� ezt Ã*rta:

> >> + 100 * IIf(letter = "H", 1, IIf(letter = "D", 2, IIf(letter = "S",
> 3, 4)))
>
> Hi. Just an idea if you want to keep the same logic is to expand the 100
> into each of the outputs.
> With IIF, each letter is generated.
> Perhaps one idea:
>
> + 9368050 Mod (Asc(letter) + 447)
>
> --
> Dana DeLouis
>
>
> "Stefi" <(E-Mail Removed)> wrote in message
> news:27CAEA99-7A08-4A65-BA37-(E-Mail Removed)...
> > Hi Geoff,
> >
> > I tested again my function and found a typo in it indeed:
> > If Right(strchr, 1) >= "0" And Right(strchr, 1) <= "9" Then _
> > strchr = Mid(origstr, codepos, 31)
> > is wrong, the correct line is
> > If Right(strchr, 1) >= "0" And Right(strchr, 1) <= "9" Then _
> > strchr = Mid(origstr, codepos, 3)
> >
> > With this correction the function deals with strings starting by 13S as
> well.
> >
> > Thanks for your contribution!
> >
> > Regards,
> > Stefi
> >
> > „Geoffâ€� ezt Ã*rta:
> >
> >> The previous solution only parses the string in twos therfore will fail
> if
> >> the code number starts with for example 13C
> >> I would suggest the following adaptation:
> >>
> >> Sub test()
> >>
> >> Dim tbl2 As Variant
> >> Dim j As Long
> >>
> >> tbl2 = range(Cells(1, 1), Cells(Cells(Rows.Count,
> "A").End(xlUp).Row, 1))
> >>
> >> For j = LBound(tbl2, 1) To UBound(tbl2, 1)
> >> If Not tbl2(j, 1) = "" Then tbl2(j, 1) = ReOrder(tbl2(j, 1))
> >> Next j
> >> range(Cells(1, 2), Cells(Cells(Rows.Count, "A").End(xlUp).Row, 2)) =
> tbl2
> >>
> >> End Sub
> >>
> >> Function ReOrder(origstr) As String
> >>
> >> Dim strarr(4)
> >> Dim weightarr(4)
> >> Dim resultarr(4)
> >> Dim codepos As Long
> >> Dim strchr As String
> >> Dim i As Long, j As Long
> >> Dim letter As String
> >> Dim arrmin As Long
> >> Dim minpos As Long
> >> Dim sChar As String
> >> Dim sStr(4)
> >>
> >> i = 0
> >> For j = 0 To 4
> >> For i = i + 1 To Len(origstr)
> >> sChar = Mid(origstr, i, 1)
> >> If sChar Like "*[HDSC]*" Then
> >> sStr(j) = sStr(j) & sChar
> >> Exit For
> >> End If
> >> If Not sChar Like "*[!0-9]*" Then sStr(j) = sStr(j) & sChar
> >> Next i
> >> Next j
> >>
> >> codepos = 1
> >> j = 0
> >>
> >> For i = 1 To 5
> >> strchr = sStr(j)
> >> codepos = codepos + Len(strchr)
> >> strarr(i - 1) = strchr
> >> letter = Right(strchr, 1)
> >> weightarr(i - 1) = Val(Left(strchr, Len(strchr) - 1)) + _
> >> 100 * IIf(letter = "H", 1, IIf(letter = "D",
> 2,
> >> IIf(letter = "S", 3, 4)))
> >> j = j + 1
> >> Next i
> >>
> >> For i = 1 To 5
> >> arrmin = WorksheetFunction.Min(weightarr)
> >> minpos = WorksheetFunction.Match(arrmin, weightarr, 0)
> >> resultarr(i - 1) = strarr(minpos - 1)
> >> weightarr(minpos - 1) = 1000
> >> Next i
> >>
> >> ReOrder = Join(resultarr, "")
> >>
> >> End Function
> >>
> >> hth
> >>
> >> Geoff
> >>
> >> "Stefi" wrote:
> >>
> >> > Try this USF as a possible solution:
> >> >
> >> > Function ReOrder(origstr)
> >> > Dim strarr(4)
> >> > Dim weightarr(4)
> >> > Dim resultarr(4)
> >> > codepos = 1
> >> > For i = 1 To 5
> >> > strchr = Mid(origstr, codepos, 2)
> >> > If Right(strchr, 1) >= "0" And Right(strchr, 1) <= "9" Then _
> >> > strchr = Mid(origstr, codepos, 31)
> >> > codepos = codepos + Len(strchr)
> >> > strarr(i - 1) = strchr
> >> > letter = Right(strchr, 1)
> >> > weightarr(i - 1) = Val(Left(strchr, Len(strchr) - 1)) + _
> >> > 100 * IIf(letter = "H", 1, IIf(letter = "D", 2,
> IIf(letter =
> >> > "S", 3, 4)))
> >> > Next i
> >> > For i = 1 To 5
> >> > arrmin = WorksheetFunction.Min(weightarr)
> >> > minpos = WorksheetFunction.Match(arrmin, weightarr, 0)
> >> > resultarr(i - 1) = strarr(minpos - 1)
> >> > weightarr(minpos - 1) = 1000
> >> > Next i
> >> > ReOrder = Join(resultarr, "")
> >> > End Function
> >> >
> >> > Sub test()
> >> > x = ReOrder(Range("A1"))
> >> > End Sub
> >> >
> >> > Regards,
> >> > Stefi
> >> >
> >> >
> >> > „James8309â€� ezt Ã*rta:
> >> >
> >> > > Hi everyone,
> >> > >
> >> > > I have bunch of codes in this structure:
> >> > >
> >> > > -'N''A' , where N = Number from 1 to 13, A = Alaphabet H,D,S,C
> >> > >
> >> > > in each cell, I have 5 of codes above combined together.
> >> > > e.g. 1D3S4C3D13S
> >> > >
> >> > >
> >> > > Problem is, those Alphabet codes and numbers have orders.
> >> > >
> >> > > i.e.
> >> > > Condition 1. H > D > S > C, if it is bigger, it needs to be
> positioned
> >> > > left side.
> >> > > Condition 2. 1 is the biggest 13 is the smallest same rule applies.
> >> > >
> >> > > so if I have this code in cell A1 for an example : 5H8C3D1D13S
> >> > > this should really be arranged as 5H1D3D3S8C because H is the first
> >> > > priority 5H comes very first, 1D comes before 3D because number 1
> is
> >> > > higher priority than 3 and they came before 3S because of the
> alphabet
> >> > > code 'D'.
> >> > >
> >> > > if I have an empty cell A1 (this is where I will be putting these
> >> > > 5codes in random order), how do i make it arrange it properly and
> >> > > display in B1 automatically according to those two conditions?
> >> > >
> >> > >
> >> > > thank you for your help in advance.
> >> > >
> >> > >
> >> > > regards,
> >> > >
> >> > > James
> >> > >
>