Or using collection
Sub perhab()
Dim a, i as long, z as new collection,ids,ii as long,v(),x,n as long,ar
a = Sheets("Sheet1").range("A1:Q1000").value 'Change sheet name and range as needed
For i = 1 to Ubound(a)
ids =Cstr(a(i,1)) ' column A
n = 0
For ii = 1 to Ubound(a,2)
n = n +1
Redim Preserve v(1 to n)
v(n) = a(i,ii)
Next ii
'add to col
on error resume next
z.add key:= ids,item:= v
If err.Number > 0 then
x = z(ids)
z.remove ids
For ii = lbound(x) to Ubound(x)
x(ii) = iif(x(ii)= "" and a(i,ii) <>"",a(i,ii),x(ii))
Next ii
z.add key:= ids, item:= x
err.Clear
End if
On error goto 0
Next i
Redim ar(1 to z.count,1 to Ubound(a,2))
For i = 1 to z.count
n = 0
For each x in z(i)
n = n +1
ar(i,n) = x
Next x
Next i
Set z = nothing
With sheets.add
.[a1].resize(ubound(ar,1),Ubound(ar,2)).value = ar
End with
End sub
Bookmarks