Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
I'm trying to look at a works sheet and list all the unique items
found on that sheet in another sheet. The source sheet has around 50 columns of varying length. The following codes was slightly modified from http://www.ozgrid.com/forum/showthread.php?t=39790 which comes close to doing what I need. I need the area analyzed to be dynamic so I added counting the used columns and rows (nCol and nRow) and tried to work them into the code. the column count was pretty easy to work in but the row count which seems to correspond to the upper bound of "y" is not responding well to my attempts. Part of the problem is my ignorance of the dictionary script thing that is implemented in the code. Any help will be appreciated. Sub test() Dim ws1 As Worksheet, ws2 As Worksheet Dim dic As Object, w, y Dim a, i As Long Dim nCol As Integer Dim nRows As Integer Set dic = CreateObject("Scripting.Dictionary") Set ws1 = Sheets("List") ' alter if needed With ws1.Range("a1").CurrentRegion a = .Value End With nCol = ws1.UsedRange.Columns.Count nRows = ws1.UsedRange.Rows.Count For i = LBound(a, 1) To UBound(a, 1) If Not IsEmpty(a(i, 1)) Then If Not dic.exists(a(i, 1)) Then ReDim w(1 To nCol) For ii = 1 To nCol w(ii) = a(i, ii) Next dic.Add a(i, 1), w Else w = dic(a(i, 1)): w(nCol) = Val(w(nCol)) + Val(a(i, nCol)) dic(a(i, 1)) = w End If End If Next y = dic.items: Set dic = Nothing On Error Resume Next Set ws2 = Sheets("Summary") If ws2 Is Nothing Then Set ws2 = Sheets.Add ws2.Name = ("Summary") End If On Error GoTo 0 With ws2.Range("a1") .CurrentRegion.ClearContents With .Range("a1") For i = LBound(y) To UBound(y) .Offset(i).Resize(, UBound(y(i))) = y(i) Next End With End With Set ws1 = Nothing: Set ws2 = Nothing Erase a, y, w End Sub |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
tagging unique items in a list | Excel Worksheet Functions | |||
Unique Items in Drp-down List | Excel Programming | |||
VBA to get List of Unique Items from column | Excel Programming | |||
VBA to get List of Unique Items from column | Excel Programming | |||
VBA to get List of Unique Items from column | Excel Programming |