Re: Generate list from excel fields

Quote from jindon;574831Use one of these

Code Display More`Sub InCell() Dim a, i As Long, n As Long a = Range("a1").CurrentRegion.Value n = 1 With CreateObject("Scripting.Dictionary") For i = 2 To UBound(a, 1) If Not .exists(a(i, 1)) Then n = n + 1 a(n, 1) = a(i, 1) a(n, 2) = a(i, 2) .Item(a(i, 1)) = n Else a(.Item(a(i, 1)), 2) = _ a(.Item(a(i, 1)), 2) & ", " & a(i, 2) End If Next End With Range("d1").Resize(n, 2).Value = a End Sub Sub InColumn() Dim a, i As Long, n As Long, maxCol As Long, w a = Range("a1").CurrentRegion.Value ReDim Preserve a(1 To UBound(a, 1), 1 To 100) With CreateObject("Scripting.Dictionary") For i = 2 To UBound(a, 1) If Not .exists(a(i, 1)) Then n = n + 1 a(n, 1) = a(i, 1) a(n, 2) = a(i, 2) .Item(a(i, 1)) = VBA.Array(n, 2) Else w = .Item(a(i, 1)) w(1) = w(1) + 1 If w(1) > UBound(a, 2) Then ReDim Preserve a(1 To UBound(a, 1), 1 To w(1)) End If a(w(0), w(1)) = a(i, 2) maxCol = Application.Max(maxCol, w(1)) .Item(a(i, 1)) = w End If Next End With Sheets(2).Range("a1").Resize(n, maxCol).Value = a`

Nice script

Biz