Code to run Based on Cell value

[KNKN9]

Hi,

I have the code

Sub Iteration_Status()Dim response As Variant
'input box that can accept both text and numbers
response = Application.InputBox("Enter Iteration Status Number", "Numbers Only", , , , , , 1 + 2)
If response = "False" Then
'code distinguishes between "False" on clicking the Cancel button as compared to "False" entered in the input box as a string value which returns 0
MsgBox "Cancel has been pressed"
ElseIf response = "" Then
MsgBox "A zero-length string ("") has been entered"
Else
'reurns "0" (zero) both if either "0" is entered in input box or "False" is entered in input box
MsgBox response, vbOKCancel
End If
ActiveCell.Value = "IT" & response
End Sub


Sub Rework_Status()
Dim response As Variant
'input box that can accept both text and numbers
response = Application.InputBox("Enter Rework Status Number", "Numbers Only", , , , , , 1 + 2)
If response = "False" Then
'code distinguishes between "False" on clicking the Cancel button as compared to "False" entered in the input box as a string value which returns 0
MsgBox "Cancel has been pressed"
ElseIf response = "" Then
MsgBox "A zero-length string ("") has been entered"
Else
'reurns "0" (zero) both if either "0" is entered in input box or "False" is entered in input box
MsgBox response, vbOKCancel
End If
ActiveCell.Value = "REW" & response
End Sub
Sub Rebrief_Status()
Dim response As Variant
'input box that can accept both text and numbers
response = Application.InputBox("Enter Rebrief Status Number", "Numbers Only", , , , , , 1 + 2)
If response = "False" Then
'code distinguishes between "False" on clicking the Cancel button as compared to "False" entered in the input box as a string value which returns 0
MsgBox "Cancel has been pressed"
ElseIf response = "" Then
MsgBox "A zero-length string ("") has been entered"
Else
'reurns "0" (zero) both if either "0" is entered in input box or "False" is entered in input box
MsgBox response, vbOKCancel
End If
ActiveCell.Value = "REB" & response
End Sub

inserted into module and in the sheet itself I have the code

Private Sub Worksheet_Change(ByVal Target As Range)If Not Intersect(Target, Range("F7")) Is Nothing Then
    Select Case Range("F7")
        Case "Iteration Status": Iteration_Status
        Case "Rework Status":   Rework_Status
        Case "Rebrief Status": Rebrief_Status
        End Select
End If
End Sub

.

However, my code only works for case1 when the cell has "iteration status" and not for the other values. But I can't see why I it not running for the other 2 cases . Thanks in advanced for your help.

 

[steve the fish]

See if this works:

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Range("F7")) Is Nothing Then
    Select Case LCase(Trim(Range("F7").Value))
        Case "iteration status": Iteration_Status
        Case "rework status":   Rework_Status
        Case "rebrief status": Rebrief_Status
    End Select
End If

End Sub

 

[KNKN9]

Perfect This works

See if this works:

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Range("F7")) Is Nothing Then
    Select Case LCase(Trim(Range("F7").Value))
        Case "iteration status": Iteration_Status
        Case "rework status":   Rework_Status
        Case "rebrief status": Rebrief_Status
    End Select
End If

End Sub

 

[KNKN9]

Sorry the code did seem to work at the end. I now have this problem.
Code:
Private Sub Worksheet_Change(ByVal Target As Range)Dim rng As Range
Set rng = Range("G6:AB100")
If Not Application.Intersect(rng, Range(Target.Address)) Is Nothing Then
Select Case LCase(Trim(rng).Value)
Case "iteration status": Iteration_Status
Case "rework status ": Rework_Status
Case "rebrief status ": Rebrief_Status
End Select
End If


End Sub
and i receive error type mismatch for Select Case LCase(Trim(rng).Value).
Can you please help

 

[steve the fish]

So you want to run those macros 1000's of times potentially?

 

[KNKN9]

yes correct.. I have a dropdown list in more than one column. So my aim is whenever I select the droplist value in any column within the sheet I want the corresponding code to run. Hope that makes sense

 

[steve the fish]

Ok lets try like this:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rng As Range

Set rng = Intersect(Range("G6:AB100"), Target)
If Not rng Is Nothing Then
    If rng.Cells.Count > 1 Then Exit Sub
    Select Case LCase(Trim(Target.Value))
        Case "iteration status": Iteration_Status
        Case "rework status": Rework_Status
        Case "rebrief status": Rebrief_Status
    End Select
End If

End Sub

 

[KNKN9]

Perfect... Thank you very much. I was really struggling to get this to work for multiple columns. Your help is much appreciated !!!

 

[steve the fish]

Bear in mind if you change more than one cell at once this doesnt run. I presume you wouldnt be doing that with dropdowns. If you may then you need to loop through the changed cells.

 

[KNKN9]

No I won't be doing them at the same time. But thank you for letting me know.