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.

  1. sort them on alphabetic columns deem important.
  2. 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))

  3. copy formula right 1 column fill both columns down far data goes

  4. filter on 2 columns, removing blanks.

            radiations measurements prm-9000

  5. 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.

    rad measurement collection

location of microsoft scripting runtime - in visual basic editor (aka vbe) choose tools ► references (alt+t,r) , scroll down little more halfway find it.

        microsoft scripting runtime


Comments

Popular posts from this blog

Payment information shows nothing in one page checkout page magento -

tcpdump - How to check if server received packet (acknowledged) -