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

Popular posts from this blog

javascript - Karma not able to start PhantomJS on Windows - Error: spawn UNKNOWN -

Nuget pack csproj using nuspec -

c# - Display ASPX Popup control in RowDeleteing Event (ASPX Gridview) -