try:



Sub Test()

Dim arrIn As Variant, arrOut As Variant

Dim myDic As Object

Dim LRow As Long

Dim rngC As Range

Dim i As Long



'Last row in column A

LRow = Cells(Rows.Count, 1).End(xlUp).Row



'changes all values to proper case

For Each rngC In Range("A2:A" & LRow)

rngC = WorksheetFunction.Proper(rngC)

Next

'Writes the values in an array

arrIn = Range("A2:A" & LRow)



'creates unique items

Set myDic = CreateObject("Scripting.Dictionary")

For i = LBound(arrIn) To UBound(arrIn)

myDic(arrIn(i, 1)) = arrIn(i, 1)

Next

'Writes the unique items in an array

arrOut = myDic.items



'Writes the values three times in column B

For i = 2 To 2 * myDic.Count + 2 Step myDic.Count

Cells(i, 2).Resize(myDic.Count, 1) =

WorksheetFunction.Transpose(arrOut)

Next



'Set first part to LCase

For Each rngC In Cells(2, 2).Resize(myDic.Count, 1)

rngC = LCase(rngC)

Next

'Set second part to UCase

For Each rngC In Cells(2 + myDic.Count, 2).Resize(myDic.Count, 1)

rngC = UCase(rngC)

Next

'Third part is already proper case

End Sub





Regards

Claus B.

--


That does it just perfect! Thanks, Claus.

And also thanks for the comments within the code. That will help me in the future.

It seems every time I try to write to an array my examples syntax don't fit the scheme I am dealing with.

I had a web site that had many basic examples of the number of ways to write to an array but its gone from my Favorites list for some unknown reason.

Is there one you can recommend?

Thanks again.

Howard