test to column issues

[rhino4eva]

CAT3,MMCS,FLC
MMCS,TIS
CAT3,MMCS,FLC,ANTIB
FLM,MMCS,FLC,ANTIB
CAT3,MMCS,FLC,ANTIB
CAT3,MMCS,FLC
MMCS,TIS,ANTIB
CAT3,MMCS,TIS,ANTIB
MMCS,SW1,WASP22,ANTIB
CAT3,MMCS,FLC
CAT3,MMCS,FLC
CAT3,MMCS,FLC
FLM,MMCS,FLC,ANTIB
CAT3,MMCS,FLC,ANTIB,SERO
CAT3,MMCS,FLC
CAT3,MMCS,FLC
CAT3,MMCS,FLC
CAT3,MMCS,FLC
CAT3,MMCS,SW1,ANTIB
CAT3,MMCS,FLC,FLM
FLM,MMCS,FLC,ANTIB
MMCS,TIS
CAT3,MMCS,FLC
CAT3,MMCS,FLC,FLM,ANTIB
CAT3,MMCS,FLC,FLM,ANTIB

ok so I realise this is a big ask and I understand that its in the realms of custom programming that an cost $1000 a time but I would like to ask if anyone can help first

above is an extract from a list consisting of a variable width and length
I can record a text to columns macro delimited by commas, that ok
but I need a macro to sort/filter each row into a discreet column

 

[MickG]

I'm not sure this is what you want , but you will know when you run the code.
Your data assumed to start "A1".
Results will overwrite data.

[COLOR="Navy"]Sub[/COLOR] MG14May08
[COLOR="Navy"]Dim[/COLOR] Ray [COLOR="Navy"]As[/COLOR] Variant, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Sp [COLOR="Navy"]As[/COLOR] Variant, Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
Ray = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
ReDim nRay(1 To UBound(Ray, 1), 1 To 1)

[COLOR="Navy"]For[/COLOR] n = 1 To UBound(Ray, 1)
    Sp = Split(Ray(n, 1), ",")
    [COLOR="Navy"]For[/COLOR] Ac = 0 To UBound(Sp)
        [COLOR="Navy"]If[/COLOR] Not .Exists(Sp(Ac)) [COLOR="Navy"]Then[/COLOR]
            c = c + 1
            ReDim Preserve nRay(1 To UBound(Ray, 1), 1 To c)
            .Add Sp(Ac), c
             nRay(n, .Item(Sp(Ac))) = Sp(Ac)
        [COLOR="Navy"]Else[/COLOR]
            nRay(n, .Item(Sp(Ac))) = Sp(Ac)
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] Ac
[COLOR="Navy"]Next[/COLOR] n
Range("A1").Resize(UBound(Ray, 1), UBound(nRay, 2)).Value = nRay
[COLOR="Navy"]End[/COLOR] With

[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[rhino4eva]

WOW .... this is just what I want ...thank you

 

[MickG]

You're welcome