This should be close... It runs against the active sheet createing a new
sheet as you have described.

Sub test()
Dim rng As Range
Dim rngStart As Range
Dim rngPaste As Range
Dim wksNew As Worksheet
Dim rngColumns As Range

Set rngColumns = ActiveSheet.Range("A2:H2")
Set wksNew = Worksheets.Add
Set rngPaste = wksNew.Range("A2")

For Each rngStart In rngColumns
Set rng = rngStart

Do While Not IsEmpty(rng.Value)
If Application.CountIf(Range(rngStart, rng), rng.Value) = 1 Then
rngPaste.Value = rng.Value & " (" & _
Application.CountIf(rng.EntireColumn, rng.Value) & ")"
Set rngPaste = rngPaste.Offset(1, 0)
End If
Set rng = rng.Offset(1, 0)
Loop
Set rngPaste = wksNew.Cells(2, rngPaste.Column + 1)
Next rngStart

End Sub
--
HTH...

Jim Thomlinson


"Jack Sons" wrote:

Hi all,

In colums A to M the a number of cells (say 1 to 20 at most) contain coded
information like B45K of 345Tgd or contain nothing.
Example (hope it will not be garbled by transmission):

A B C D E F
G H I
er34 g67BB 12E HNG33 78R4E er34 12E
12E AAA KHG5 K8K9 K8K9
12E nwG 12E er34
HNG33 12E er34

In each column I want to show only the unique information with the number of
times it occurs in that column, so the above example it would result in
this:

A B C D
E F G H I
er34 ( 1 ) g67BB ( 1 ) 12E ( 2 ) HNG33 ( 2 ) 78R4E
( 1 ) er34 ( 3 ) 12E ( 1 )
12E ( 1 ) AAA ( 1 ) KHG5 ( 1 )
K8K9 ( 1 ) K8K ( 1 )
nwG
( 1 ) 12E ( 2 )

I'm looking for code to accomplish this, your assistance will be
appreciated.

Jack Sons
The Netherlands