Changing Orders

[James8309]

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

 

[Franz Erhart]

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)

 

[Stefi]

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:

 

[Geoff]

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]

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

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:

 

[Geoff]

Hi Stefi

Indeed it does - and less verbose too <g>

Geoff

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

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

 

[Stefi]

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

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

:

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

 

[James8309]

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

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

 

[Stefi]

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:

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>

"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!

„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


"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

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

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.

 

[Stefi]

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:

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

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

:

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

 

[James8309]

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 the100
into each of the outputs.
With IIF, each letter is generated.
Perhaps one idea:

+ 9368050 Mod (Asc(letter) + 447)

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

Thank you so much stefi !!!

 

[Stefi]

You are welcome! Thanks for the feedback!
Stefi