excel - Move cells into 1 row according to column A and Data and Time from Column D -

excel - Move cells into 1 row according to column A and Data and Time from Column D -

i think photo should pretty much tell trying achieve.

i can still seek explain bit.

i have on top table 5 column b c d e

column main contains num record individual numbers can have 8 records.

i need set record in 1 line num.

it sort , d.

i need move column c based on time occurred.

i added column because can have 8 non created , upto 4 cause created record.

i assuming follwoing

the table 1 in sheet called "input" the output generated in sheet called "output" have headers in place

paste code in module , run it

option explicit sub sample() dim wsinput worksheet, wsoutput worksheet dim wsilrow long, wsolrow long, long, c long, nc long dim wsirng range, fltrdrng range, cl range dim col new collection dim itm set wsinput = sheets("input") set wsoutput = sheets("output") wsinput wsilrow = .range("a" & .rows.count).end(xlup).row set wsirng = .range("a1:e" & wsilrow) wsirng .sort key1:=.range("a2"), order1:=xlascending, key2:=.range("d2") _ , order2:=xlascending, header:=xlyes, ordercustom:=1, matchcase:=false _ , orientation:=xltoptobottom, dataoption1:=xlsortnormal, dataoption2:= _ xlsortnormal end = 2 wsilrow on error resume next col.add .cells(i, 1).value, chr(34) & .cells(i, 1).value & chr(34) on error goto 0 next end wsolrow = 2 wsoutput each itm in col .cells(wsolrow, 1).value = itm wsolrow = wsolrow + 1 next wsolrow = .range("a" & .rows.count).end(xlup).row = 2 wsolrow wsinput '~~> remove filters .autofiltermode = false wsirng '<~~ filter, offset(to exclude headers) .autofilter field:=1, criteria1:=wsoutput.cells(i, 1).value set fltrdrng = .offset(1, 0).specialcells(xlcelltypevisible) end '~~> remove filters .autofiltermode = false end '<~~ c cause column , nc non cause c = 3: nc = 7 each cl in fltrdrng.cells if cl.column = 3 , len(trim(cl.value)) <> 0 if instr(1, cl.value, "cause", vbtextcompare) .cells(i, c).value = wsinput.cells(cl.row, 3).value c = c + 1 elseif instr(1, cl.value, "non", vbtextcompare) .cells(i, nc).value = wsinput.cells(cl.row, 3).value nc = nc + 1 end if .cells(i, 2).value = wsinput.cells(cl.row, 2).value .cells(i, 15).value = wsinput.cells(cl.row, 5).value end if next next end end sub

screenshot

input sheet

output sheet

note: future changes construction has incorporated in code well.

excel excel-2007 excel-formula