Exit code if cell contains specific value

[Chewyhairball]

Hi
When i input a value in column C it populates various other cells in the same row and when I delete an item in column C it returns cells in the same row to blank.

This works fine for me but I am trying to add some code that says if column J contains the word 'Approved' then when you try to delete and item in column 'C in the same row as this
you get a message saying you cant delete it and the code exits.

any help with this would be great.

thanks

Private Sub Worksheet_Change(ByVal Target As Range)



Dim cell As Range

For Each cell In Target

On Error Resume Next



If cell.Column = Range("C10:C2000").Column Then

If cell.Value <> "" Then

Cells(cell.Row, "D").Value = Application.WorksheetFunction.VLookup(Cells(cell.Row, "C"), Sheets("Item plus supplier").Range("C2:D2000"), 2, False)



Else



Cells(cell.Row, "D").Value = ""



End If

End If



If cell.Column = Range("C10:C2000").Column Then

If cell.Value <> "" Then



Cells(cell.Row, "G").Value = Now & " " & Environ("UserName")

Cells(cell.Row, "H").Value = "New Request"

Cells(cell.Row, "J").Value = ""

Cells(cell.Row, "p").Value = Environ("UserName")

Cells(cell.Row, "Q").Value = ""

Cells(cell.Row, "i").Select

Call ShowShapes

ActiveCell.Offset(1, -6).Activate



Else



Cells(cell.Row, "D").Value = ""

Cells(cell.Row, "E").Value = ""

Cells(cell.Row, "F").Value = ""

Cells(cell.Row, "G").Value = ""

Cells(cell.Row, "H").Value = ""

Cells(cell.Row, "K").Value = ""

Cells(cell.Row, "L").Value = ""

Cells(cell.Row, "M").Value = ""

Cells(cell.Row, "P").Value = ""

Cells(cell.Row, "Q").Value = ""

Cells(cell.Row, "H").ClearComments

Cells(cell.Row, "J").Value = ""

Cells(cell.Row, "i").Select

Call HideShapes

ActiveCell.Offset(0, -6).Activate

End If

End If



If cell.Column = Range("J:J").Column Then

If cell.Value = "Purchase Order Raised" Then

Cells(cell.Row, "N").Value = "by " & Environ("UserName") & " " & Now

End If

End If



If cell.Column = Range("J:J").Column Then

If cell.Value = "Ordered" Then

Cells(cell.Row, "O").Value = "by " & Environ("UserName") & " " & Now

End If

End If



Next cell

End Sub

 

[Chewyhairball]

I have played around with various takes on the folllowing but i cant get anything to work. The code triggers when i type 'approved into column J but thats not what i want

If Intersect(Target, Range("J:J")) = "Approved" then
 msgBox ("Item cannot be deleted")
 exit sub
else
continue with code...

 

[HaHoBe]

Hi,

try

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range

Application.EnableEvents = False
For Each cell In Target

'  On Error Resume Next
  If Not Intersect(cell, Range("C10:C2000")) Is Nothing Then
    If cell.Value <> "" Then
      cell.Offset(0, 1).Value = WorksheetFunction.VLookup(cell.Value, Sheets("Item plus supplier").Range("C2:D2000"), 2, False)
      cell.Offset(0, 4).Value = Now & " " & Environ("UserName")
      cell.Offset(0, 5).Value = "New Request"
      cell.Offset(0, 7).Value = ""
      cell.Offset(0, 13).Value = Environ("UserName")
      cell.Offset(0, 14).Value = ""
     
      '/// procedure not known but most likely to work on ActiveCell. Should be rewritten to
      '/// avoid moving the cursor and range address be passed by parameter as either String or Range
      Cells(cell.Row, "i").Select
      Call HideShapes
      ActiveCell.Offset(0, -6).Activate   'if necessary to move cursor why not: cell.Select
      '///
    Else
      cell.Offset(0, 1).Resize(1, 5).Value = ""
      cell.Offset(0, 7).Resize(1, 4).Value = ""
      cell.Offset(0, 13).Resize(1, 2).Value = ""
     
      '/// procedure not known but most likely to work on ActiveCell. Should be rewritten to
      '/// avoid moving the cursor and range address be passed by parameter as either String or Range
      Cells(cell.Row, "i").Select
      Call HideShapes
      ActiveCell.Offset(0, -6).Activate   'if necessary to move cursor why not: cell.Select
      '///
    End If
  End If
 
  If cell.Column = 10 Then
    If cell.Value = "Purchase Order Raised" Then
      Cells(cell.Row, "N").Value = "by " & Environ("UserName") & " " & Now
    ElseIf cell.Value = "Ordered" Then
      Cells(cell.Row, "O").Value = "by " & Environ("UserName") & " " & Now
    End If
  End If
Next cell
Application.EnableEvents = True

End Sub

Ciao,
Holger

 

[Chewyhairball]

Cool! I’m not currently at my pc but will try it as soon as I am home

 

[Chewyhairball]

Put the code in but nothing happens. Type item into cell in column C and nothing happens after that?

 

[HaHoBe]

Hi,

code behind the sheet the changes should take place? If so, type this into the immediate window (if not open/visible in the VBE press CTRL+G)

?Application.EnableEvents

and hit Enter. This will print the status of this event to fire. If the result False is displayed enter at a new line

Application.EnableEvents = True

without the interrogation mark and hit Enter. You may check the status by setting the cursor behind the first code provided and hit Enter - result should be different by now.

If the result True is delivered I must confess I do not have a clue by now (if the code is in the right place). I'll keep thinking of any other possibilities (I exclude that the workbook is opened with the warning that macros are not activated).

Ciao,
Holger