create possible pairs

[modiria50989]

Please help me out.

I have a column like below (location:column B):

M 255129 255173 1 C 347122 348458 1 C 255319 255352 99

M 631064 631067 3 C 631140 631141 6

M 255129 255173 1 M 255173 255207 4 M 255158 255207 1 C 255319 255352 99

<colgroup><col></colgroup><tbody>
</tbody>

.
.
.

I am looking for a code to group all possible M and C pairs like below (optional location: column C):

M 255129 255173 1 C 347122 348458 1
M 255129 255173 1 C 255319 255352 99
M 631064 631067 3 C 631140 631141 6
M 255129 255173 1 C 255319 255352 99
M 255173 255207 4 C 255319 255352 99
M 255158 255207 1 C 255319 255352 99
.
.
.

Thank you!

 

[MickG]

Try this for results starting "C1".

[COLOR="Navy"]Sub[/COLOR] MG19Sep10
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, Sp [COLOR="Navy"]As[/COLOR] Variant, m [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] nRay() [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] A [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] B [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] nStr [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] p [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range("B1", Range("B" & Rows.Count).End(xlUp))
p = 0
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    m = 0: c = 0
    Dn.Value = Replace(Replace(Dn.Value, "M", "#M"), "C", "#C")
        Sp = Split(Dn.Value, "#")
            ReDim ray(1 To UBound(Sp) + 1, 1 To 2)
                [COLOR="Navy"]For[/COLOR] n = 1 To UBound(Sp)
                    [COLOR="Navy"]If[/COLOR] Left(Trim(Sp(n)), 1) = "M" [COLOR="Navy"]Then[/COLOR]
                         m = m + 1
                        ray(m, 1) = Sp(n)
                    [COLOR="Navy"]ElseIf[/COLOR] Left(Trim(Sp(n)), 1) = "C" [COLOR="Navy"]Then[/COLOR]
                        c = c + 1
                        ray(c, 2) = Sp(n)
                    [COLOR="Navy"]End[/COLOR] If
                [COLOR="Navy"]Next[/COLOR] n

    [COLOR="Navy"]For[/COLOR] A = 1 To m
        [COLOR="Navy"]For[/COLOR] B = 1 To c
           ReDim Preserve nRay(p)
           nRay(p) = ray(A, 1) & " " & ray(B, 2)
           p = p + 1
        [COLOR="Navy"]Next[/COLOR] B
    [COLOR="Navy"]Next[/COLOR] A
   
    Dn.Value = Replace(Replace(Dn.Value, "#M", "M"), "#C", "C")
[COLOR="Navy"]Next[/COLOR] Dn
Range("C1").Resize(UBound(nRay) + 1).Value = Application.Transpose(nRay)
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[modiria50989]

Works. Thank you!

 

[MickG]

You're welcome