See if this does what you want.
<font face=Courier New><br><SPAN style="color:#00007F">Sub</SPAN> Unique_List()<br> <SPAN style="color:#00007F">Dim</SPAN> a<br> <SPAN style="color:#00007F">Dim</SPAN> i <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, j <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, LR <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, LC <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, k <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br> <SPAN style="color:#00007F">Dim</SPAN> s <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN><br> <br> a = Range("A1:AX2454").Value<br> LR = <SPAN style="color:#00007F">UBound</SPAN>(a, 1)<br> LC = <SPAN style="color:#00007F">UBound</SPAN>(a, 2)<br> <SPAN style="color:#00007F">With</SPAN> CreateObject("Scripting.Dictionary")<br> .CompareMode = vbTextCompare<br> <SPAN style="color:#00007F">For</SPAN> i = 1 <SPAN style="color:#00007F">To</SPAN> LR<br> <SPAN style="color:#00007F">For</SPAN> j = 1 <SPAN style="color:#00007F">To</SPAN> LC<br> s = a(i, j)<br> <SPAN style="color:#00007F">If</SPAN> Len(s) > 0 <SPAN style="color:#00007F">Then</SPAN><br> <SPAN style="color:#00007F">If</SPAN> <SPAN style="color:#00007F">Not</SPAN> .Exists(s) <SPAN style="color:#00007F">Then</SPAN><br> k = k + 1<br> .Add s, s<br> <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br> <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br> <SPAN style="color:#00007F">Next</SPAN> j<br> <SPAN style="color:#00007F">Next</SPAN> i<br> Range("AZ1").Resize(k).Value = Application.Transpose(Array(.Keys))<br> <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br><br></FONT>