excel Worksheet_SelectionChange - copying data -
scenario:
i have 2 worksheets same except "some content" in sheet2 column c-e, , sheet1 containing worksheet_selectionchange handler
when click on column b in sheet1 worksheet_selectionchange changes cell colour , sets column c-e of sheet2 column c
problem:
trouble falls on over application error...
can please, annoying...just how copy data sheet2 sheet 1 in worksheet_selectionchange handler?
if set s1c = "x" (as in hardcoded it's fine), when try reference cell second sheet doesn't work.
many in advance, best regards
code follows:
public benrel public rskopt public resopt public getrow public getcol private sub worksheet_selectionchange(byval target range) on error goto exitsubcorrectly 'turn off multiple recurring changes application.enableevents = false 'do not allow range selection if target.cells.count > 1 goto exitsubcorrectly 'only allow selection within our range set myrange = range("b8:b24") if not application.intersect(target, myrange) nothing ' @ least 1 cell of target within range myrange. ' carry out action. getrow = target.row getcol = target.column select case range(cells(target.row, target.column), cells(target.row, target.column)).style case "normal" range(cells(target.row, target.column), cells(target.row, target.column)).style = "accent1" getdata putdata case "accent1" range(cells(target.row, target.column), cells(target.row, target.column)).style = "normal" range(cells(target.row, target.column + 1), cells(target.row, target.column + 3)).value = "" case else end select else ' no cell of target in in range. out. goto exitsubcorrectly end if exitsubcorrectly: ' go , turn on changes ' msgbox err.description worksheets("sheet1").select application.enableevents = true end sub sub getdata() worksheets("sheet2").select range(cells(getrow, getcol), cells(getrow, getcol)).select benrel = range(cells(getrow, getcol), cells(getrow, getcol)).offset(0, 1).value rskopt = range(cells(getrow, getcol), cells(getrow, getcol)).offset(0, 2).value resopt = range(cells(getrow, getcol), cells(getrow, getcol)).offset(0, 3).value end sub sub putdata() worksheets("sheet1").select range(cells(target.row, target.column), cells(target.row, target.column)).offset(0, 1).value = benrel range(cells(target.row, target.column), cells(target.row, target.column)).offset(0, 2).value = rskopt range(cells(target.row, target.column), cells(target.row, target.column)).offset(0, 3).value = resopt end sub
it looks me replace 3 routines with
private sub worksheet_selectionchange(byval target range) on error goto exitsubcorrectly 'turn off multiple recurring changes application.enableevents = false 'do not allow range selection if target.cells.count > 1 goto exitsubcorrectly 'only allow selection within our range set myrange = range("b8:b24") if not application.intersect(target, myrange) nothing ' @ least 1 cell of target within range myrange. ' carry out action. cells(target.row, target.column) select case .style case "normal" .style = "accent1" .offset(0, 1).resize(, 3).value = worksheets("sheet2").cells(getrow, getcol).offset(0, 1).resize(, 3).value case "accent1" .style = "normal" .offset(0, 1).resize(, 3).clearcontents case else end select end end if exitsubcorrectly: ' go , turn on changes ' msgbox err.description application.enableevents = true end sub
Comments
Post a Comment