Freeze when Triggered

dgavin

Active Member
Joined
Feb 16, 2005
Messages
302
A1 contains a result that increases and descreases during my excel operation.

I want to freeze the result when B2 = 1
 

Some videos you may like

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)

VoG

Legend
Joined
Jun 19, 2002
Messages
63,650
Right click the sheet tab, select View Code and paste in

Code:
Private Sub Worksheet_Calculate()
If Range("B1") = 1 Then
    With Range("A1")
        .Value = .Value
    End With
End If
End Sub
 

dgavin

Active Member
Joined
Feb 16, 2005
Messages
302
Thanks for that but

I seem to get a "Ambiguous name detected: Worksheet_Calculate" error

is it because Private Sub Worksheet_Calculate() is used previously in my VBA ?
 

dgavin

Active Member
Joined
Feb 16, 2005
Messages
302

ADVERTISEMENT

Private Sub Worksheet_Calculate()

Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, wb1 As Workbook
Set wb1 = ThisWorkbook
Set ws1 = wb1.Sheets("sheet1")
Set ws2 = wb1.Sheets("Controls")
Set ws3 = wb1.Sheets("Log")



If ws2.Cells(29, 4) = 1 Then
ws1.Range("q5:u50") = ""
End If


If ws2.Cells(34, 4) = 1 Then


whichrow = ws2.Cells(19, 4)
basestake = ws2.Cells(21, 11)
laststake = ws2.Cells(19, 11)
lastbalance = ws2.Cells(20, 11)
balance = ws1.Cells(2, 9)
logrow = ws2.Cells(22, 11)
startbalance = ws2.Cells(7, 5)
stakediv = ws2.Cells(8, 5)
maximumstake = ws2.Cells(9, 5)



thistarget = startbalance + (basestake * (logrow - 1))
ws3.Cells(logrow, 8) = thistarget



If ws2.Cells(4, 5) = 1 Then
backorlay = "BACK"
Else
backorlay = "LAY"
End If




If ws2.Cells(11, 2) = 1 Then

If balance < lastbalance Then
thisstake = laststake + basestake
ElseIf laststake > basestake Then
thisstake = laststake - (basestake / 5)
Else
thisstake = basestake
End If
ElseIf ws2.Cells(11, 2) = 2 Then

thisstake = (thistarget - balance) / stakediv
If thisstake < basestake Then
thisstake = basestake
End If
If thisstake > maximumstake Then
thisstake = maximumstake
End If


Else
thisstake = basestake
End If


ws2.Cells(19, 11) = thisstake
ws2.Cells(20, 11) = balance





Select Case ws2.Cells(13, 2)
Case Is = 0
layodds = ws1.Cells(whichrow, 4)
Case Is = 1
layodds = ws1.Cells(whichrow, 6)
Case Is = 2
layodds = ws1.Cells(whichrow, 8)
Case Is = 3
layodds = ws1.Cells(whichrow, 10)
Case Is = 4
layodds = ws2.Cells(6, 2)
End Select



ws1.Cells(whichrow, 18) = layodds
ws1.Cells(whichrow, 19) = Round(thisstake, 2)
ws1.Cells(whichrow, 17) = backorlay




ws3.Cells(logrow, 1) = ws1.Cells(1, 1)
ws3.Cells(logrow, 2) = ws1.Cells(whichrow, 1)
ws3.Cells(logrow, 3) = backorlay
ws3.Cells(logrow, 4) = Round(thisstake, 2)
ws3.Cells(logrow, 5) = layodds
ws3.Cells(logrow, 6) = ws1.Cells(2, 4)
ws3.Cells(logrow, 7) = balance

ws2.Cells(22, 11) = logrow + 1



ws2.Cells(18, 11) = ws1.Cells(1, 1)


If Range("D20").Value = Sheets("Sheet4").Range("B2").Value Then
If Range("D23").Value = 0 Then Range("D23").Value = 1
Else
If Range("D23").Value <> 1 Then Range("D23").Value = 0
End If



End If


End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)


End Sub

Private Sub Worksheet_Calculate()
If Range("D26") = 1 Then
With Range("D18")
.Value = .Value
End With
End If
End Sub
 

VoG

Legend
Joined
Jun 19, 2002
Messages
63,650
Try

Private Sub Worksheet_Calculate()

Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, wb1 As Workbook
Set wb1 = ThisWorkbook
Set ws1 = wb1.Sheets("sheet1")
Set ws2 = wb1.Sheets("Controls")
Set ws3 = wb1.Sheets("Log")

If Range("D26") = 1 Then
With Range("D18")
.Value = .Value
End With
End If


If ws2.Cells(29, 4) = 1 Then
ws1.Range("q5:u50") = ""
End If


If ws2.Cells(34, 4) = 1 Then


whichrow = ws2.Cells(19, 4)
basestake = ws2.Cells(21, 11)
laststake = ws2.Cells(19, 11)
lastbalance = ws2.Cells(20, 11)
balance = ws1.Cells(2, 9)
logrow = ws2.Cells(22, 11)
startbalance = ws2.Cells(7, 5)
stakediv = ws2.Cells(8, 5)
maximumstake = ws2.Cells(9, 5)



thistarget = startbalance + (basestake * (logrow - 1))
ws3.Cells(logrow, 8) = thistarget



If ws2.Cells(4, 5) = 1 Then
backorlay = "BACK"
Else
backorlay = "LAY"
End If




If ws2.Cells(11, 2) = 1 Then

If balance < lastbalance Then
thisstake = laststake + basestake
ElseIf laststake > basestake Then
thisstake = laststake - (basestake / 5)
Else
thisstake = basestake
End If
ElseIf ws2.Cells(11, 2) = 2 Then

thisstake = (thistarget - balance) / stakediv
If thisstake < basestake Then
thisstake = basestake
End If
If thisstake > maximumstake Then
thisstake = maximumstake
End If


Else
thisstake = basestake
End If


ws2.Cells(19, 11) = thisstake
ws2.Cells(20, 11) = balance





Select Case ws2.Cells(13, 2)
Case Is = 0
layodds = ws1.Cells(whichrow, 4)
Case Is = 1
layodds = ws1.Cells(whichrow, 6)
Case Is = 2
layodds = ws1.Cells(whichrow, 8)
Case Is = 3
layodds = ws1.Cells(whichrow, 10)
Case Is = 4
layodds = ws2.Cells(6, 2)
End Select



ws1.Cells(whichrow, 18) = layodds
ws1.Cells(whichrow, 19) = Round(thisstake, 2)
ws1.Cells(whichrow, 17) = backorlay




ws3.Cells(logrow, 1) = ws1.Cells(1, 1)
ws3.Cells(logrow, 2) = ws1.Cells(whichrow, 1)
ws3.Cells(logrow, 3) = backorlay
ws3.Cells(logrow, 4) = Round(thisstake, 2)
ws3.Cells(logrow, 5) = layodds
ws3.Cells(logrow, 6) = ws1.Cells(2, 4)
ws3.Cells(logrow, 7) = balance

ws2.Cells(22, 11) = logrow + 1



ws2.Cells(18, 11) = ws1.Cells(1, 1)


If Range("D20").Value = Sheets("Sheet4").Range("B2").Value Then
If Range("D23").Value = 0 Then Range("D23").Value = 1
Else
If Range("D23").Value <> 1 Then Range("D23").Value = 0
End If



End If


End Sub
[/code]
 

dgavin

Active Member
Joined
Feb 16, 2005
Messages
302
That seemed to work ok, thanks

i've added another similar code below it

If Range("D26") = 1 Then
With Range("D18")
.Value = .Value
End With
End If

If Range("D26") = 1 Then
With Range("D21")
.Value = .Value
End With
End If

But when D26 =1 the workbook seems to commence calculating (excel eggtimer flashes repeatedly) but then crashes ?
 

VoG

Legend
Joined
Jun 19, 2002
Messages
63,650
If there are multiple dependencies perhaps

Code:
Application.EnableEvents = False
If Range("D26") = 1 Then
With Range("D18")
.Value = .Value
End With
End If

If Range("D26") = 1 Then
With Range("D21")
.Value = .Value
End With
End If
Application.EnableEvents = True
 

Watch MrExcel Video

Forum statistics

Threads
1,109,127
Messages
5,526,993
Members
409,733
Latest member
revender17

This Week's Hot Topics

Top