Revert back to original cell value if condition met - excel vba

Hello,

I am working with Excel/VBA and I have 4 inputs on Sheet1 (cells B2, B6, B7 and B8) that go into a calculation on Sheet2 (cell W8).  Certain combinations of values entered into the 4 inputs on Sheet1 can cause the calculation on Sheet2 to go negative.  In this case, I would like the value of the input on Sheet1 (can be caused by any one of the inputs) to revert back to the previous value just before the entered value caused the calculation on Sheet2 to go negative.

I know this cannot be done inline with Excel functions and requires some VBA coding.  I already have a Worksheet_Change function set up so that when the Target.Address = any one of the 4 input cells, then it calls another function (NegX_Msg_Popup()) that checks if the calculation on Sheet2 cell W8 is negative and if so, gives a popup message but allows the entered value which caused the negative value to remain.  I would like to keep the popup but have the value revert back to the last "good" value entered.

I tried to add a line in the NegX_Msg_Popup function which if Sheets("Sheet2").Range("W8").Value < 0 Then
Range("B2").Value = Range("B2").Value

but this put me into a circular reference and caused the workbook to hang up.

I have also tried on workbook open, creating a copy of the input worksheet thinking that if the negative condition was met that I would replace the active worksheet cell with the value from when the sheet first opened but then this only restores the original value when first opened but not if multiple changes are made before tripping the negative calculation function.

Any clever ideas on how I can achieve this?

Thanks so much!
Michelle MAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Wayne Taylor (webtubbs)Commented:
You can use the Undo function to return to the previous value. Also, disable events so you don't get stuck in a loop...

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, [B2,B6:B8]) Is Nothing Then
        NegX_Msg_Popup
    End If
End Sub

Private Sub NegX_Msg_Popup()
    If [W8] < 0 Then
        If MsgBox("The value in W8 is negative. Retain changed value?", vbYesNo) = vbNo Then
            Application.EnableEvents = False
            Application.Undo
            Application.EnableEvents = True
        End If
    End If
End Sub

Open in new window

Martin LissOlder than dirtCommented:
Try this approach which uses a userform and enter 4 numeric values. It is set up to enter the data in sheet1 only if the the total is less that 25. You can of course change the calculation to suit your needs.
28699776.xlsm
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
I think that's very tricky problem and it also depends on how do you want it ultimately.
Anyways try the below code to see if this is something you can work with.

Place the below code on Sheet1 Module not on a Standard Module.
i.e. right click the Sheet1 Tab --> View Code --> Paste the code given below into the opened code window --> Close the VBA Editor --> Save your workbook as Macro-Enabled Workbook.

I have placed a dummy formula in cell W8 on Sheet2 to test the code. Please change that formula with your actual formula.

Code:

Option Explicit
Dim oB2 As Long, oB6 As Long, oB7 As Long, oB8 As Long

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim chkVal
    Dim Ans As String
    If Target.Count > 1 Then Exit Sub
    chkVal = Sheets("Sheet2").Range("W8").Value
    If Not Intersect(Target, Range("B2,B6:B8")) Is Nothing Then
        Application.EnableEvents = False
        Target.Select
        If chkVal < 0 Then
            Ans = MsgBox("W8 on Sheet2 has become a negative value after changing the cell " & Target.Address(0, 0) & " on Sheet1." & vbNewLine & vbNewLine & _
                    "Do you want to retain previous values?", vbQuestion + vbYesNo)
            If Ans = vbNo Then
                Application.EnableEvents = True
                Exit Sub
            End If
            If oB2 <> 0 Then
                Range("B2").Value = oB2
            Else
                Range("B2").Value = ""
            End If
            If oB6 <> 0 Then
                Range("B6").Value = oB6
            Else
                Range("B6").Value = ""
            End If
            If oB7 <> 0 Then
                Range("B7").Value = oB7
            Else
                Range("B7").Value = ""
            End If
            If oB8 <> 0 Then
                Range("B8").Value = oB8
            Else
                Range("B8").Value = ""
            End If
        End If
        Application.EnableEvents = True
    End If
End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("B2,B6:B8")) Is Nothing Then
        Application.EnableEvents = False
        If Target.Address(0, 0) = "B2" Then
            oB2 = Target
            If oB6 = 0 Then oB6 = Range("B6").Value
            If oB7 = 0 Then oB7 = Range("B7").Value
            If oB8 = 0 Then oB8 = Range("B8").Value
        ElseIf Target.Address(0, 0) = "B6" Then
            oB6 = Target
            If oB2 = 0 Then oB2 = Range("B2").Value
            If oB7 = 0 Then oB7 = Range("B7").Value
            If oB8 = 0 Then oB8 = Range("B8").Value
        ElseIf Target.Address(0, 0) = "B7" Then
            oB7 = Target
            If oB2 = 0 Then oB2 = Range("B2").Value
            If oB6 = 0 Then oB6 = Range("B6").Value
            If oB8 = 0 Then oB8 = Range("B8").Value
        ElseIf Target.Address(0, 0) = "B8" Then
            oB8 = Target
            If oB2 = 0 Then oB2 = Range("B2").Value
            If oB6 = 0 Then oB6 = Range("B6").Value
            If oB7 = 0 Then oB7 = Range("B7").Value
        End If
        Application.EnableEvents = True
    End If
End Sub

Open in new window


For details, refer to the attached workbook.
Populate-Previous-Values-If-Negative-Out

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Michelle MAuthor Commented:
I think the approach by webtubbs and sktneer will do the trick but I will have to tweak it a bit since
1.  I do not want the user to have a choice to revert back to the original value that caused the calculation to go negative but still receives a message.
2. I have other functions that will need to be called for certain, but not all input cells. E.g.  When a value in B6 is entered, it calls a function unique only to B6's value being changed.  

For these modifications do I change the code to the following?
Option Explicit
Dim oB2 As Long, oB6 As Long, oB7 As Long, oB8 As Long

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim chkVal
    Dim Ans As String
    If Target.Count > 1 Then Exit Sub
    chkVal = Sheets("Sheet2").Range("W8").Value
    If Not Intersect(Target, Range("B2,B6:B8")) Is Nothing Then
        Application.EnableEvents = False
        Target.Select
        If chkVal < 0 Then
            Ans = MsgBox("W8 on Sheet2 has become a negative value after changing the cell " & Target.Address(0, 0) & " on Sheet1." & vbNewLine & vbNewLine)
    
            If oB2 <> 0 Then
                Range("B2").Value = oB2
            Else
                Range("B2").Value = ""
            End If
            If oB6 <> 0 Then
                Range("B6").Value = oB6
                Call min_Width
            Else
                Range("B6").Value = ""
                Call min_Width
            End If
            If oB7 <> 0 Then
                Range("B7").Value = oB7
            Else
                Range("B7").Value = ""
            End If
            If oB8 <> 0 Then
                Range("B8").Value = oB8
            Else
                Range("B8").Value = ""
            End If
        End If
        Application.EnableEvents = True
    End If
End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("B2,B6:B8")) Is Nothing Then
        Application.EnableEvents = False
        If Target.Address(0, 0) = "B2" Then
            oB2 = Target
            If oB6 = 0 Then oB6 = Range("B6").Value
            If oB7 = 0 Then oB7 = Range("B7").Value
            If oB8 = 0 Then oB8 = Range("B8").Value
        ElseIf Target.Address(0, 0) = "B6" Then
            oB6 = Target
            If oB2 = 0 Then oB2 = Range("B2").Value
            If oB7 = 0 Then oB7 = Range("B7").Value
            If oB8 = 0 Then oB8 = Range("B8").Value
        ElseIf Target.Address(0, 0) = "B7" Then
            oB7 = Target
            If oB2 = 0 Then oB2 = Range("B2").Value
            If oB6 = 0 Then oB6 = Range("B6").Value
            If oB8 = 0 Then oB8 = Range("B8").Value
        ElseIf Target.Address(0, 0) = "B8" Then
            oB8 = Target
            If oB2 = 0 Then oB2 = Range("B2").Value
            If oB6 = 0 Then oB6 = Range("B6").Value
            If oB7 = 0 Then oB7 = Range("B7").Value
        End If
        Application.EnableEvents = True
    End If
End Sub

Private Sub min_Width()
    If Range("B6").Value > 360 Then
    Range("B6").Value = 360
    End If
End Sub

Open in new window


Thanks everyone for your help!
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
You're welcome Michelle!
Glad you tweaked the code as per your requirement. :)
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.