Select Case problem when hitting the Delete key

G

gab1972

Below is my code. Basically, when the user selects "Final Decision in
any of the cells in range g30:g54, a userform pops up and they select
Approved or Denied. This places that in the cell to the right of that
field. The problem is that sometimes this will change from Final
Decision to something else and then I want that Approved or Denied
removed. Using the worksheet change function works great until I hit
"Delete". When I delete the value from g30 I get a Type Mismatch
error. I'm assuming it's looking for a value and there isn't one
there. If the value is deleted, I want the cell to the right to be
cleared.

Any ideas?

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

Application.ScreenUpdating = False
ActiveWorkbook.Sheets("AppendPermit").Unprotect
Application.EnableEvents = False

' Check cell A30
' If the cell is empty, leave it alone and don't check
If Range("A30") = "" Then
GoTo Fin
End If

' If cell A30 equals anything other than "Maint.", then display an
error
' empty the cell and place the cursor back at that cell
If Range("A30").Value <> "Maint." Then
MsgBox ("All permits originate from the Maintenance level.
Please enter 'Maint.'"), vbInformation, "Ruh roh. Wrong value."
Range("A30").Value = "Maint."
Range("A30").Select
GoTo Fin
End If

If Application.Intersect(Target, Range("g30:j54")) Is Nothing Then
GoTo Fin
Else
With Sheets("AppendPermit").Range("g30:j54")
Select Case Target.Value

Case ""
Target.Offset(0, 1).Value = ""

Case "Final Decision"
If Target.Offset(0, 1).Value = "" Then
Decision.Show
Target.Offset(0, 1).Value = Sheets("Lists").Range("Q7")
End If

Case Else
Target.Offset(0, 1).Value = ""
End Select
End With
End If

Fin:
Application.ScreenUpdating = True
ActiveWorkbook.Sheets("AppendPermit").Protect
Application.EnableEvents = True
End Sub
 
G

gab1972

Below is my code.  Basically, when the user selects "Final Decision in
any of the cells in range g30:g54, a userform pops up and they select
Approved or Denied.  This places that in the cell to the right of that
field.  The problem is that sometimes this will change from Final
Decision to something else and then I want that Approved or Denied
removed.  Using the worksheet change function works great until I hit
"Delete".  When I delete the value from g30 I get a Type Mismatch
error.  I'm assuming it's looking for a value and there isn't one
there.  If the value is deleted, I want the cell to the right to be
cleared.

Any ideas?

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

Application.ScreenUpdating = False
ActiveWorkbook.Sheets("AppendPermit").Unprotect
Application.EnableEvents = False

' Check cell A30
' If the cell is empty, leave it alone and don't check
    If Range("A30") = "" Then
        GoTo Fin
    End If

' If cell A30 equals anything other than "Maint.", then display an
error
' empty the cell and place the cursor back at that cell
    If Range("A30").Value <> "Maint." Then
        MsgBox ("All permits originate from the Maintenance level..
Please enter 'Maint.'"), vbInformation, "Ruh roh.  Wrong value."
        Range("A30").Value = "Maint."
        Range("A30").Select
        GoTo Fin
    End If

If Application.Intersect(Target, Range("g30:j54")) Is Nothing Then
GoTo Fin
Else
    With Sheets("AppendPermit").Range("g30:j54")
    Select Case Target.Value

    Case ""
    Target.Offset(0, 1).Value = ""

    Case "Final Decision"
    If Target.Offset(0, 1).Value = "" Then
            Decision.Show
            Target.Offset(0, 1).Value = Sheets("Lists").Range("Q7")
    End If

    Case Else
        Target.Offset(0, 1).Value = ""
    End Select
    End With
End If

Fin:
Application.ScreenUpdating = True
ActiveWorkbook.Sheets("AppendPermit").Protect
Application.EnableEvents = True
End Sub
Click to expand...

And once again, I find and answer to my own problem...

Here's what I came up with:

On Error GoTo ErrorTrap '<---- added this
If Intersect(Target, Range("g30:j54")) Is Nothing Then
GoTo Fin
Else
.....
.....
End If
GoTo Fin
ErrorTrap: '<--- and this
Target.Offset(0, 1).Value = ""
....
....
 
P

Per Jessen

Hi

Always remeber to tell which line is causing the error (which line is
highlighted when you click Debug).

I don't see what you are using the 'with...end with' statemnt for..

Rewrote your code a bit to get rid of goto statements:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Application.EnableEvents = False
Application.ScreenUpdating = False

ActiveWorkbook.Sheets("AppendPermit").Unprotect

' Check cell A30
' If the cell is empty, leave it alone and don't check
If Not Range("A30") = "" Then
' If cell A30 equals anything other than "Maint.", then display an error
' empty the cell and place the cursor back at that cell
If Range("A30").Value <> "Maint." Then
MsgBox ("All permits originate from the Maintenance level. Please
enter 'Maint.'"), vbInformation, "Ruh roh. Wrong value."
Range("A30").Value = "Maint."
Range("A30").Select
End If
ElseIf Not Application.Intersect(Target, Range("g30:j54")) Is Nothing Then
'With Sheets("AppendPermit").Range("g30:j54")
Select Case Target.Value
Case ""
Target.Offset(0, 1).Value = ""
Case "Final Decision"
If Target.Offset(0, 1).Value = "" Then
Decision.Show
Target.Offset(0, 1).Value = Sheets("Lists").Range("Q7")
End If
Case Else
Target.Offset(0, 1).Value = ""
End Select
'End With
End If

Application.ScreenUpdating = True
ActiveWorkbook.Sheets("AppendPermit").Protect
Application.EnableEvents = True
End Sub

Regards,
Per

"gab1972" <[email protected]> skrev i meddelelsen
Below is my code. Basically, when the user selects "Final Decision in
any of the cells in range g30:g54, a userform pops up and they select
Approved or Denied. This places that in the cell to the right of that
field. The problem is that sometimes this will change from Final
Decision to something else and then I want that Approved or Denied
removed. Using the worksheet change function works great until I hit
"Delete". When I delete the value from g30 I get a Type Mismatch
error. I'm assuming it's looking for a value and there isn't one
there. If the value is deleted, I want the cell to the right to be
cleared.

Any ideas?

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

Application.ScreenUpdating = False
ActiveWorkbook.Sheets("AppendPermit").Unprotect
Application.EnableEvents = False

' Check cell A30
' If the cell is empty, leave it alone and don't check
If Range("A30") = "" Then
GoTo Fin
End If

' If cell A30 equals anything other than "Maint.", then display an
error
' empty the cell and place the cursor back at that cell
If Range("A30").Value <> "Maint." Then
MsgBox ("All permits originate from the Maintenance level.
Please enter 'Maint.'"), vbInformation, "Ruh roh. Wrong value."
Range("A30").Value = "Maint."
Range("A30").Select
GoTo Fin
End If

If Application.Intersect(Target, Range("g30:j54")) Is Nothing Then
GoTo Fin
Else
With Sheets("AppendPermit").Range("g30:j54")
Select Case Target.Value

Case ""
Target.Offset(0, 1).Value = ""

Case "Final Decision"
If Target.Offset(0, 1).Value = "" Then
Decision.Show
Target.Offset(0, 1).Value = Sheets("Lists").Range("Q7")
End If

Case Else
Target.Offset(0, 1).Value = ""
End Select
End With
End If

Fin:
Application.ScreenUpdating = True
ActiveWorkbook.Sheets("AppendPermit").Protect
Application.EnableEvents = True
End Sub
Click to expand...

And once again, I find and answer to my own problem...

Here's what I came up with:

On Error GoTo ErrorTrap '<---- added this
If Intersect(Target, Range("g30:j54")) Is Nothing Then
GoTo Fin
Else
.....
.....
End If
GoTo Fin
ErrorTrap: '<--- and this
Target.Offset(0, 1).Value = ""
....
....
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Junp start my Select Case Macro 12
Deleting specific information 1
Select Case code error 8
input info when pasted in cells 5
Drop down list control value in vba 2
Select Case Code does not run... 10
Pass condition formatting across worksheets via vba. 0
VBA triggers on tabkey 8

Top