excel - Error when select multiple cells and press delete/backspace -
i have following code. stuff when [g,g,y,y,r,r] pressed , there error handling in case other keys pressed well. works fine! however, when multiple cells in column 11 selected , delete/backspace pressed "run-time error '13': type mismatch".
private sub worksheet_change(byval target range) dim testcell dim re object dim rematches object dim cell1_1 string dim today string dim cell string thisrow = target.row 'action happens when typing [g,g,y,y,r,r] if target.column = 11 set re = createobject("vbscript.regexp") re .multiline = false .global = false .ignorecase = true .pattern = "[g,g,y,y,r,r]" end each testcell in target.cells set rematches = re.execute(testcell.value) if rematches.count > 0 , len(target.value) = 1 if len(cells(1, 1).value) = 1 today = now() cell1_1 = sheets("input").cells(1, 1).value range("l" & thisrow) = cell1_1 + ": " + format(today, "ddmmmyy") end if 'avoid typing thing elseif target.value <> vbnullstring row = target.row cells(row, 11).value = vbnullstring msgbox "please, type only:" & vbnewline & vbnewline & "g green" & vbnewline & "y yellow" & vbnewline & "r red" end if next end if end sub
the error occurs @ line in code.
if rematches.count > 0 , len(target.value) = 1
if there no lost functionality can enclose code in error handling.
private sub worksheet_change(byval target range) dim testcell dim re object dim rematches object dim cell1_1 string dim today string dim cell string thisrow = target.row 'action happens when typing [g,g,y,y,r,r] if target.column = 11 set re = createobject("vbscript.regexp") re .multiline = false .global = false .ignorecase = true .pattern = "[g,g,y,y,r,r]" end each testcell in target.cells set rematches = re.execute(testcell.value) on error goto skip '************error handle************* if rematches.count > 0 , len(target.value) = 1 if len(cells(1, 1).value) = 1 today = now() cell1_1 = sheets("input").cells(1, 1).value range("l" & thisrow) = cell1_1 + ": " + format(today, "ddmmmyy") end if 'avoid typing thing elseif target.value <> vbnullstring row = target.row cells(row, 11).value = vbnullstring msgbox "please, type only:" & vbnewline & vbnewline & "g green" & vbnewline & "y yellow" & vbnewline & "r red" end if skip: '************error handle************* on error goto 0 '************error handle************* next end if end sub
or if code still needs execute
private sub worksheet_change(byval target range) dim testcell dim re object dim rematches object dim cell1_1 string dim today string dim cell string thisrow = target.row 'action happens when typing [g,g,y,y,r,r] if target.column = 11 set re = createobject("vbscript.regexp") re .multiline = false .global = false .ignorecase = true .pattern = "[g,g,y,y,r,r]" end each testcell in target.cells set rematches = re.execute(testcell.value) on error resume next '************error handle************* if rematches.count > 0 , len(target.value) = 1 if len(cells(1, 1).value) = 1 today = now() cell1_1 = sheets("input").cells(1, 1).value range("l" & thisrow) = cell1_1 + ": " + format(today, "ddmmmyy") end if 'avoid typing thing elseif target.value <> vbnullstring row = target.row cells(row, 11).value = vbnullstring msgbox "please, type only:" & vbnewline & vbnewline & "g green" & vbnewline & "y yellow" & vbnewline & "r red" end if on error goto 0 '************error handle************* next end if end sub
Comments
Post a Comment