Creating a Multi Selection Checkbox List in Side-by-Side Cell Across Row in Excel -


i'm using vb code created l42 on 4/27/14 creates checkbox list in single cell.

option explicit dim fillrng range private sub worksheet_selectionchange(byval target range)  dim lbcolors msforms.listbox dim lbobj oleobject dim long  set lbobj=me.oleobjects("lb_colors") set lbcolors = target     if not intersect(target, [b2]) nothing       set fillrng = target      lbobj        .left = fillrng.left        .top = fillrng.top        .width = fillrng.width        .visible = true      end    else      lbobj.visible = false      if not fillrng nothing          fillrng.clearcontents          lbcolors             if .listcount <> 0               = 0 .listcount -1                  if fillrng.value =                      if .selected(i) fillrng.value = .list(i)                  else                      if .selected(i) fillrng.value = _                          fillrng.value & "," & .list(i)                  end if               next          end          set fillrng = nothing       end if     end if  end sub 

the code works , able extend checkbox list cells in complete column changing (target, [b1:b40]). following logic, thought extend checkboxes c , d columns (target, [b1:d40]. however, after selecting desired items in b column , clicking or tabing on c column, entire checkbox moves selected items without writing in previous cell. able tab on or click next cell in row , have same checkbox items populates cell item selected, independent of previous cell. tab or click succeeding cells , same , have cells retain , display selected items. can code modified that?

thank you.

to put values in cell, change code this:

option explicit dim fillrng range  private sub worksheet_selectionchange(byval target range)    dim lbcolors msforms.listbox   dim lbobj oleobject   dim long    set lbobj = me.oleobjects("lb_colors")   set lbcolors = target    lbobj.visible = false   if not fillrng nothing     fillrng.clearcontents     lbcolors       if .listcount <> 0         = 0 .listcount - 1           if .selected(i)             if fillrng.value = ""               fillrng.value = .list(i)             else               fillrng.value = fillrng.value & "," & .list(i)             end if           end if         next       end if     end     set fillrng = nothing   end if    if not intersect(target, [b1:d40]) nothing     set fillrng = target     lbobj       .left = fillrng.left       .top = fillrng.top       .width = fillrng.width       .visible = true     end   end if  end sub 

Comments