excel - Combine Rows & Sum Values in a Worksheet -
i have excel sheet below (pipe "|" delimit columns) data.
a|b|c|x|50|60 d|e|f|x|40|30 a|b|c|x|10|20 a|b|c|y|20|20 a|b|c|x|20|70 d|e|f|x|10|50 a|b|c|y|10|10
the result trying is:
a|b|c|x|80|150 a|b|c|y|30|30 d|e|f|x|50|80
values a, b, c , d, e, f unique identifiers. or d can considered. values x , y "types", , integers values sum. sample simplified, there thousands of unique identifiers, dozen of types , dozens of values sum. rows not sorted, types can located in higher or lower rows. trying avoid use of pivot table.
dim lastrow integer dim lastcol integer dim integer lastcol = sheets(1).cells(1, columns.count).end(xltoleft).column lastrow = sheets(1).cells(rows.count, 1).end(xlup).row = 1 lastrow ???? next
the code above gets point of looping through rows unclear on after point.
- sort them on alphabetic columns deem important.
in unused column right use formula following in second row,
=if($a2&$b2&$c2&$d2=$a3&$b3&$c3&$d3, "", sumifs(e:e,$a:$a, $a2,$b:$b, $b2,$c:$c, $c2,$d:$d, $d2))
copy formula right 1 column fill both columns down far data goes
filter on 2 columns, removing blanks.
optionally copy data new report worksheet , remove columns e & f.
addendum:
a more automated approach achieved form of array , simple mathematical operations. i've chosen dictionary object in order take use of indexed key recognize patterns in first 4 alphabetic identifiers.
to use scripting dictionary, need go vbe's tools ► references , add microsoft scripting runtime. following code not compile without it.
the following has been adjusted dynamic columns of keys , integers.
sub rad_collection() dim rw long, nc long, stmp string, v long, vtmp variant dim long, inumkeys long, inumints long dim drads new scripting.dictionary drads.comparemode = vbtextcompare inumkeys = 5 'possibly calculated num text (see below) inumints = 2 'possibly calculated num ints (see below) thisworkbook.sheets("sheet4").cells(1, 1).currentregion 'inumkeys = application.counta(.rows(2)) - application.count(.rows(2)) 'alternate count of txts 'inumints = application.count(.rows(2)) 'alternate count of ints rw = 2 .cells(rows.count, 1).end(xlup).row vtmp = .cells(rw, 1).resize(1, inumkeys).value2 stmp = join(application.index(vtmp, 1, 0), chr(183)) if not drads.exists(stmp) drads.add key:=stmp, item:=join(application.index(.cells(rw, inumkeys + 1).resize(1, inumints).value2, 1, 0), chr(183)) else vtmp = split(drads.item(stmp), chr(183)) v = lbound(vtmp) ubound(vtmp) vtmp(v) = vtmp(v) + .cells(rw, inumkeys + 1 + v).value2 next v drads.item(stmp) = join(vtmp, chr(183)) end if next rw rw = 1 nc = inumkeys + inumints + 1 .cells(rw, nc + 1).currentregion.clearcontents 'clear previous .cells(rw, nc + 1).resize(1, nc - 1) = .cells(rw, 1).resize(1, nc - 1).value2 each vtmp in drads.keys 'debug.print vtmp & "|" & drads.item(vtmp) rw = rw + 1 .cells(rw, nc + 1).resize(1, inumkeys) = split(vtmp, chr(183)) .cells(rw, nc + inumkeys + 1).resize(1, inumints) = split(drads.item(vtmp), chr(183)) .cells(rw, nc + inumkeys + 1).resize(1, inumints) = _ .cells(rw, nc + inumkeys + 1).resize(1, inumints).value2 next vtmp end drads.removeall: set drads = nothing end sub
just run macro against numbers have provided samples. i've assumed form of column header labels in first row. dictionary object populated , duplicates in combined identifiers have numbers summed. left split them , return them worksheet in unused area.
location of microsoft scripting runtime - in visual basic editor (aka vbe) choose tools ► references (alt+t,r) , scroll down little more halfway find it.
Comments
Post a Comment