Freeze when Triggered

D

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
 

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.
Sort by date Sort by votes
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
 
Upvote 0
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 ?
 
Upvote 0
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
 
Upvote 0
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]
 
Upvote 0
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 ?
 
Upvote 0
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
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question
Clear Filter causing freeze
Replies
1
Views
227
frabulator
frabulator
G
  • Question
Excel Table Header
Replies
7
Views
156
ISY
I
R
  • Solved
RandBetween - prevent values changing - VBA?
Replies
8
Views
457
JEC
JEC
A
  • Question
Excel freezing when saving, but not when Calculating
Replies
1
Views
188
atmanley
A
Dazzawm
  • Solved
Code To Freeze Top Row
Replies
2
Views
189
Dazzawm
Dazzawm

Forum statistics

Threads
1,214,553
Messages
6,120,184
Members
448,949
Latest member
keycalinc

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top