Changing Orders
 

Hi everyone,

I have bunch of codes in this structu

-'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

Changing Orders
 

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 structu

-'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

Changing Orders
 

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 structu

-'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

Changing Orders
 

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 structu

-'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

Changing Orders
 

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 structu

-'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

Changing Orders
 

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 structu

-'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

Changing Orders
 

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 structu

-'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

Changing Orders
 

On Jul 1, 11:26*pm, Stefi 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 structu

-'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.

Changing Orders
 

First you have to make sure you placed the code (fixed version) into a normal
module. VBAProject explorerRight click on
VBAproject(yourfilename)InsertModulePaste 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 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 structu

-'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.

Changing Orders
 

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" wrote in message
...
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 structu

-'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

Changing Orders
 

On Jul 2, 10:09*pm, Stefi wrote:
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" wrote in message
...
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 structu

-'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 -

Thank you so much stefi !!!

Changing Orders
 

You are welcome! Thanks for the feedback!
Stefi

Thank you so much stefi !!!