Line up strings of text

[PeterB1988]

Hi,

I have a list of data in sheet1. Column A contains cells which all contain text. They are capital letters apart from the right hand value which is lower case letter ("a", "b", "c", "d" or "e") e.g "TELEVISION.a", "TELEVISION.b" and so on until "TELEVISION.e". The item varies and the length of the string varies in length. the right hand letter is always lowercase.

What I am trying to do is line up corresponding items running left to right on one worksheet. The issue is that there may be multiple "TELEVISION.b" but only one "TELEVISION.a" so that would have to have an empty line.

Below I have shown the list and the result or what I am looking for.

[TABLE="width: 78"]
<tbody>[TR]
[TD]Item List
[/TD]
[/TR]
[TR]
[TD]TELEVISION.a
[/TD]
[/TR]
[TR]
[TD]TELEVISION.a
[/TD]
[/TR]
[TR]
[TD]TELEVISION.a
[/TD]
[/TR]
[TR]
[TD]LAPTOP.a
[/TD]
[/TR]
[TR]
[TD]LAPTOP.b
[/TD]
[/TR]
[TR]
[TD]LAPTOP.b
[/TD]
[/TR]
[TR]
[TD]LAPTOP.e
[/TD]
[/TR]
</tbody>[/TABLE]

End Result
[TABLE="width: 334"]
<tbody>[TR]
[TD="align: center"]"a"
[/TD]
[TD="align: center"]"b"
[/TD]
[TD="align: center"]"c"
[/TD]
[TD="align: center"]"d"
[/TD]
[TD="align: center"]"e"
[/TD]
[/TR]
[TR]
[TD="align: center"]TELEVISION.a
[/TD]
[TD="align: center"]n/a
[/TD]
[TD="align: center"]n/a
[/TD]
[TD="align: center"]n/a
[/TD]
[TD="align: center"]n/a
[/TD]
[/TR]
[TR]
[TD="align: center"]TELEVISION.a
[/TD]
[TD="align: center"]n/a
[/TD]
[TD="align: center"]n/a
[/TD]
[TD="align: center"]n/a
[/TD]
[TD="align: center"]n/a
[/TD]
[/TR]
[TR]
[TD="align: center"]TELEVISION.a
[/TD]
[TD="align: center"]n/a
[/TD]
[TD="align: center"]n/a
[/TD]
[TD="align: center"]n/a
[/TD]
[TD="align: center"]n/a
[/TD]
[/TR]
[TR]
[TD="align: center"]LAPTOP.a
[/TD]
[TD="align: center"]LAPTOP.b
[/TD]
[TD="align: center"]n/a
[/TD]
[TD="align: center"]n/a
[/TD]
[TD="align: center"]LAPTOP.e
[/TD]
[/TR]
[TR]
[TD="align: center"]n/a
[/TD]
[TD="align: center"]LAPTOP.b
[/TD]
[TD="align: center"]n/a
[/TD]
[TD="align: center"]n/a
[/TD]
[TD="align: center"]n/a
[/TD]
[/TR]
</tbody>[/TABLE]


If anybody can help me out I would really appreciate it.

Thanks

 

[MickG]

Try this for results starting "C1"

[COLOR="Navy"]Sub[/COLOR] MG29May30
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] sp [COLOR="Navy"]As[/COLOR] Variant, Num [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Q [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
Columns("C:G").ClearContents
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    sp = Split(Dn.Value, ".")
        [COLOR="Navy"]Select[/COLOR] [COLOR="Navy"]Case[/COLOR] sp(1)
            [COLOR="Navy"]Case[/COLOR] "a": Num = 0
            [COLOR="Navy"]Case[/COLOR] "b": Num = 1
            [COLOR="Navy"]Case[/COLOR] "c": Num = 2
            [COLOR="Navy"]Case[/COLOR] "d": Num = 3
            [COLOR="Navy"]Case[/COLOR] "e": Num = 4
        [COLOR="Navy"]End[/COLOR] Select
        [COLOR="Navy"]If[/COLOR] Not .Exists(sp(0)) [COLOR="Navy"]Then[/COLOR]
           .Add sp(0), Array(0, 0, 0, 0, 0)
                Q = .Item(sp(0))
                Q(Num) = Q(Num) + 1
                .Item(sp(0)) = Q
            [COLOR="Navy"]Else[/COLOR]
                 Q = .Item(sp(0))
                 Q(Num) = Q(Num) + 1
                 .Item(sp(0)) = Q
            [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]Dim[/COLOR] K [COLOR="Navy"]As[/COLOR] Variant, p [COLOR="Navy"]As[/COLOR] Variant, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] oMax [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
Range("C1:G1").Value = Array("""a""", """b""", """c""", """d""", """e""")
c = 1
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
     c = c + 1
     [COLOR="Navy"]For[/COLOR] p = 0 To 4
        [COLOR="Navy"]For[/COLOR] n = 0 To .Item(K)(p) - 1
            Cells(c + n, p + 3) = K & "." & Chr(97 + p)
         [COLOR="Navy"]Next[/COLOR] n
        oMax = Application.Max(oMax, .Item(K)(p) - 1)
    [COLOR="Navy"]Next[/COLOR] p
 c = c + oMax
 [COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]With[/COLOR] Range("C1").Resize(c, 5)
    .Borders.Weight = 2
   '[COLOR="Green"][B]Un-remark in "n/a" required[/B][/COLOR]
   '[COLOR="Green"][B] .SpecialCells(xlCellTypeBlanks) = "n/a"[/B][/COLOR]
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[PeterB1988]

Mick, Brilliant. just what i was after. great work. i really appreciate. I've got vba envy after seeing that code!! i think i need to get the practice in. thanks again.

 

[MickG]

You're welcome