Change the cells value with input box of another cells after people changed a cells

[holycome99]

Want i gonna to do is that when the people changed the cells, they will be asked for input
and right in the offset(7,1) of this cell, the cell will show the input values.
However, when i use this code, it just can't run and crash after few mins.
Please help.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rng As Range
Dim CARLBURN As String



Dim Msg As String

Msg = "What is the CARLORIES BURN for this activity?"
Set rng = Range("B5:B11")


If Not Intersect(Target, rng) Is Nothing Then



InputArea:

CARLBURN = InputBox(Msg, "CARLBURN Input")

    If CARLBURN = "" Then
    MsgBox "Please enter the CARLBURN for this activity!"
    
    Exit Sub
    
    
    
    End If
    If IsNumeric(CARLBURN) = False Then
    MsgBox "Please enter only numerical number!"
    Exit Sub
    
    
    End If
    
    

End If

    
 


Sheets("Other Activities").Select

 Target.Offset(10, 1).Value = CARLBURN
 

 

 
End Sub

 

[Dermot]

Probable cause is that when your code puts the Carlburn value in a cell, it triggers the Change event again. You need to stop that happening.

So try this

Application.EnableEvents = False
Target.Offset(10, 1).Value = CARLBURN
Application.EnableEvents = True

 

[My Aswer Is This]

Try this:

Private Sub Worksheet_Change(ByVal Target As Range)
'Modified  12/5/2020  1:17:27 AM  EST
If Not Intersect(Target, Range("B5:B11")) Is Nothing Then
If Target.Cells.CountLarge > 1 Or IsEmpty(Target) Then Exit Sub
Dim CARLBURN As String
Dim Msg As String
Msg = "What is the CARLORIES BURN for this activity?"
CARLBURN = InputBox(Msg, "CARLBURN Input")
    If CARLBURN = "" Then
    MsgBox "Please enter the CARLBURN for this activity!"
    CARLBURN = InputBox(Msg, "CARLBURN Input")
    If CARLBURN = "" Then: MsgBox "You failed to enter a value for a second time. I will stop the script": Exit Sub
End If
Target.Offset(10, 1).Value = CARLBURN
End If
End Sub

 

[Dermot]

Try this:

Private Sub Worksheet_Change(ByVal Target As Range)
'Modified  12/5/2020  1:17:27 AM  EST
If Not Intersect(Target, Range("B5:B11")) Is Nothing Then
If Target.Cells.CountLarge > 1 Or IsEmpty(Target) Then Exit Sub
Dim CARLBURN As String
Dim Msg As String
Msg = "What is the CARLORIES BURN for this activity?"
CARLBURN = InputBox(Msg, "CARLBURN Input")
    If CARLBURN = "" Then
    MsgBox "Please enter the CARLBURN for this activity!"
    CARLBURN = InputBox(Msg, "CARLBURN Input")
    If CARLBURN = "" Then: MsgBox "You failed to enter a value for a second time. I will stop the script": Exit Sub
End If
Target.Offset(10, 1).Value = CARLBURN
End If
End Sub

but that will still trigger the change event when the cell is updated, causing this sub to recurse itself...............surely that is the problem

 

[My Aswer Is This]

I'm curious why you wanted to Offset by 10

but that will still trigger the change event when the cell is updated, causing this sub to recurse itself...............surely that is the problem

I test all my scripts. The value entered will be outside the Target range. So it does not cause a problem.

 

[Dermot]

I'm curious why you wanted to Offset by 10


I test all my scripts. The value entered will be outside the Target range. So it does not cause a problem.

Doh, silly me to miss that

 

[My Aswer Is This]

I see several questions about your script but I gave a answer you may want to try.
Like if your in one sheet but then want to activate another sheet.
Like this line of code:
Sheets("Other Activities").Select
Did you want the results to be put in another sheet.

 

[holycome99]

I see several questions about your script but I gave a answer you may want to try.
Like if your in one sheet but then want to activate another sheet.
Like this line of code:
Sheets("Other Activities").Select
Did you want the results to be put in another sheet.

Works perfectly!
Thank you!!! <3

 

[My Aswer Is This]

Works perfectly!
Thank you!!! <3

Glad I was able to help you.
Come back here to Mr. Excel next time you need additional assistance.