Private Sub Worksheet_Calculate()
Application.ScreenUpdating = False
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1")
Dim x1 As Date, z1 As Date, nowtime As Date: nowtime = Now()
Dim b1 As Double, b2 As Double, b3 As Double
Dim f5Value As Variant, j5Value As Variant, n5Value As Variant, r5Value As Variant
Dim hRange As Range, lRange As Range, pRange As Range, tRange As Range
With ws
b1 = .Range("B1").Value: b2 = .Range("B2").Value: b3 = .Range("B3").Value
x1 = .Range("X1").Value: z1 = .Range("Z1").Value
f5Value = ws.Range("F5").Value: j5Value = ws.Range("J5").Value
n5Value = ws.Range("N5").Value: r5Value = ws.Range("R5").Value
Set hRange = Union(ws.Range("H5"), ws.Range("H9:H16"))
Set lRange = Union(ws.Range("L5"), ws.Range("L9:L16"))
Set pRange = Union(ws.Range("P5"), ws.Range("P9:P16"))
Set tRange = Union(ws.Range("T5"), ws.Range("T9:T16"))
End With
Dim hasFormula As Boolean: Dim cell As Range
Dim col As Variant
'If x1 is not a valid date or z1 is not a valid date or b1 is not a numeric value or b2 is not a numeric value or b3 is not a numeric value, then the code will exit the current sub-routine or function and return control to the calling code.
'The IsDate() function checks if a given value is a valid date, while the IsNumeric() function checks if a given value is a numeric value.
If Not (IsDate(x1) And IsDate(z1) And IsNumeric(b1) And IsNumeric(b2) And IsNumeric(b3)) Then Exit Sub
'Action 1
If z1 <= nowtime Then
ws.Range("E5,E9:E16,I5,I9:I16,M5,M9:M16,Q5,Q9:Q16").ClearContents 'Clear multiple ranges
Set cell = ws.Range("F5")
Application.EnableEvents = False: Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
cell.FormulaR1C1 = "=RC[1]"
Application.EnableEvents = True: Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
For Each Rng In Array(hRange, lRange, pRange, tRange)
Debug.Print Rng.Address
If Rng.Cells(1).Value <> 10 Then
Application.EnableEvents = False: Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
Rng.Value = 10
Application.EnableEvents = True: Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
End If
Set cell = Rng.Cells(1)
Application.EnableEvents = False: Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
Rng.Value = 10
Application.EnableEvents = True: Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
If Rng <> rRange Then Set cell = cell.Offset(8, 0)
Next Rng
End If
'Action 2
If x1 < nowtime And nowtime <= z1 Then
If f5Value > b3 And f5Value < b1 And f5Value >= b2 And ws.Range("F5").Offset(-2, 0).Value <= b3 And ws.Range("H5").Value = 10 Then
If ws.Range("F5").hasFormula Then
Dim f5Range As Range
Set f5Range = ws.Range("F5")
If Not f5Range Is Nothing Then
Application.EnableEvents = False: Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
With f5Range
.Value = .Value
End With
Application.EnableEvents = True: Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
End If
Dim f9f16Range As Range
Set f9f16Range = ws.Range("F9:F16")
If Not f9f16Range Is Nothing Then
Application.EnableEvents = False: Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
With f9f16Range
.Value = .Value
End With
Application.EnableEvents = True: Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
End If
hRange.Value = 20
End If
ElseIf j5Value > b3 And j5Value < b1 And j5Value >= b2 And Range("J5").Offset(-2, 0).Value <= b3 And Range("L5").Value = 10 Then
If Range("J5").hasFormula Then
Dim j5Range As Range
Set j5Range = ws.Range("J5")
If Not j5Range Is Nothing Then
Application.EnableEvents = False: Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
With j5Range
.Value = .Value
End With
Application.EnableEvents = True: Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
End If
Dim j9j16Range As Range
Set j9j16Range = ws.Range("J5:J16")
If Not j9j16Range Is Nothing Then
Application.EnableEvents = False: Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
With j9j16Range
.Value = .Value
End With
Application.EnableEvents = True: Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
End If
lRange.Value = 20
End If
ElseIf n5Value > b3 And n5Value < b1 And n5Value >= b2 And ws.Range("N5").Offset(-2, 0).Value <= b3 And Range("O5").Value = 10 Then
If ws.Range("N5").hasFormula Then
Dim n5Range As Range
Set n5Range = ws.Range("N5")
If Not n5Range Is Nothing Then
Application.EnableEvents = False: Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
With n5Range
.Value = .Value
End With
Application.EnableEvents = True: Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
End If
Dim n9n16Range As Range
Set n9n16Range = ws.Range("N9:N16")
If Not n9n16Range Is Nothing Then
Application.EnableEvents = False: Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
With n9n16Range
.Value = .Value
End With
Application.EnableEvents = True: Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
End If
pRange.Value = 20
End If
ElseIf r5Value > b3 And r5Value < b1 And r5Value >= b2 And ws.Range("R5").Offset(-2, 0).Value <= b3 And Range("T5").Value = 10 Then
If ws.Range("R5").hasFormula Then
Dim r5Range As Range
Set r5Range = ws.Range("R5")
If Not r5Range Is Nothing Then
Application.EnableEvents = False: Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
With r5Range
.Value = .Value
End With
Application.EnableEvents = True: Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
End If
Dim r9r16Range As Range
Set r9r16Range = ws.Range("R9:R16")
If Not r9r16Range Is Nothing Then
Application.EnableEvents = False: Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
With r9r16Range
.Value = .Value
End With
Application.EnableEvents = True: Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
End If
tRange.Value = 20
End If
End If
End If
'Action 3
If x1 < nowtime And nowtime <= z1 Then
For Each col In Array("F", "J", "N", "R")
Select Case col
Case "F"
f5Value = ws.Range(col & "5").Value
Dim ff5Range As Range
Set ff5Range = ws.Range(col & "5")
If Not ff5Range Is Nothing Then
If f5Value <= b3 And f5Value < b1 And f5Value >= b2 And ff5Range.hasFormula And ws.Range(col & "5").Offset(0, 3).Value = 10 Then
Application.EnableEvents = False: Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
If ws.Range(col & "5").Offset(-1, 0).Value > ws.Range(col & "5").Offset(0, 1).Value Then
ws.Range(col & "5").Offset(0, -1).Value = f5Value
ws.Range(col & "9:" & col & "16").Offset(0, -1).Value = ws.Range(col & "9:" & col & "16").Value
hRange.Value = 20
End If
With ff5Range
.Value = .Value
End With
Dim ff9ff16Range As Range
Set ff9ff16Range = ws.Range(col & "9:" & col & "16")
If Not ff9ff16Range Is Nothing Then
With ff9ff16Range
.Value = .Value
End With
Application.EnableEvents = True: Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
hRange.Value = 20
End If
Case "J"
j5Value = ws.Range(col & "5").Value
Dim jj5Range As Range
Set jj5Range = ws.Range(col & "5")
If Not jj5Range Is Nothing Then
If j5Value <= b3 And j5Value < b1 And j5Value >= b2 And jj5Range.hasFormula And ws.Range(col & "5").Offset(0, 3).Value = 10 Then
Application.EnableEvents = False: Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
If ws.Range(col & "5").Offset(-1, 0).Value > ws.Range(col & "5").Offset(0, 1).Value Then
ws.Range(col & "5").Offset(0, -1).Value = j5Value
ws.Range(col & "9:" & col & "16").Offset(0, -1).Value = ws.Range(col & "9:" & col & "16").Value
lRange.Value = 20
End If
With jj5Range
.Value = .Value
End With
Dim jj9jj16Range As Range
Set jj9jj16Range = ws.Range(col & "9:" & col & "16")
If Not jj9jj16Range Is Nothing Then
With jj9jj16Range
.Value = .Value
End With
Application.EnableEvents = True: Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
lRange.Value = 20
End If
Case "N"
n5Value = ws.Range(col & "5").Value
Dim nn5Range As Range
Set nn5Range = ws.Range(col & "5")
If Not nn5Range Is Nothing Then
If n5Value <= b3 And n5Value < b1 And n5Value >= b2 And nn5Range.hasFormula And ws.Range(col & "5").Offset(0, 3).Value = 10 Then
Application.EnableEvents = False: Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
If ws.Range(col & "5").Offset(-1, 0).Value > ws.Range(col & "5").Offset(0, 1).Value Then
ws.Range(col & "5").Offset(0, -1).Value = n5Value
ws.Range(col & "9:" & col & "16").Offset(0, -1).Value = ws.Range(col & "9:" & col & "16").Value
pRange.Value = 20
End If
With nn5Range
.Value = .Value
End With
Dim nn9nn16Range As Range
Set nn9nn16Range = ws.Range(col & "9:" & col & "16")
If Not nn9nn16Range Is Nothing Then
With nn9nn16Range
.Value = .Value
End With
Application.EnableEvents = True: Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
pRange.Value = 20
End If
Case "R"
r5Value = ws.Range(col & "5").Value
Dim rr5Range As Range
Set rr5Range = ws.Range(col & "5")
If Not rr5Range Is Nothing Then
If r5Value <= b3 And r5Value < b1 And r5Value >= b2 And rr5Range.hasFormula And ws.Range(col & "5").Offset(0, 3).Value = 10 Then
Application.EnableEvents = False: Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
If ws.Range(col & "5").Offset(-1, 0).Value > ws.Range(col & "5").Offset(0, 1).Value Then
ws.Range(col & "5").Offset(0, -1).Value = r5Value
ws.Range(col & "9:" & col & "16").Offset(0, -1).Value = ws.Range(col & "9:" & col & "16").Value
tRange.Value = 20
End If
With rr5Range
.Value = .Value
End With
Dim rr9rr16Range As Range
Set rr9rr16Range = ws.Range(col & "9:" & col & "16")
If Not rr9rr16Range Is Nothing Then
With rr9rr16Range
.Value = .Value
End With
Application.EnableEvents = True: Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
tRange.Value = 20
End If
End Select
Next col
End If
'Action 5
If x1 < Now() And Now() <= z1 Then
If f5Value <= b3 And f5Value < b1 And f5Value >= b2 And ws.Range("H5").Value = 10 Then
If Not ws.Range("F5").hasFormula Then
Dim ffff5Range As Range
Set ffff5Range = ws.Range("F5")
If Not ffff5Range Is Nothing Then
Application.EnableEvents = False: Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
ffff5Range.FormulaR1C1 = "=RC[1]"
Application.EnableEvents = True: Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
End If
Dim ffff9ffff16Range As Range
Set ffff9ffff16Range = ws.Range("F9:F16")
If Not ffff9ffff16Range Is Nothing Then
Application.EnableEvents = False: Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
ffff9ffff16Range.FormulaR1C1 = "=RC[1]"
Application.EnableEvents = True: Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
End If
hRange.Value = 20
End If
ElseIf j5Value <= b3 And j5Value < b1 And j5Value >= b2 And Range("L5").Value = 10 Then
If Not ws.Range("J5").hasFormula Then
Dim jjjj5Range As Range
Set jjjj5Range = ws.Range("J5")
If Not jjjj5Range Is Nothing Then
Application.EnableEvents = False: Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
jjjj5Range.FormulaR1C1 = "=RC[1]"
Application.EnableEvents = True: Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
End If
Dim jjjj9jjjj16Range As Range
Set jjjj9jjjj16Range = ws.Range("J9:J16")
If Not jjjj9jjjj16Range Is Nothing Then
Application.EnableEvents = False: Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
jjjj9jjjj16Range.FormulaR1C1 = "=RC[1]"
Application.EnableEvents = True: Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
End If
lRange.Value = 20
End If
ElseIf n5Value <= b3 And n5Value < b1 And n5Value >= b2 And Range("O5").Value = 10 Then
If Not ws.Range("N5").hasFormula Then
Dim nnnn5Range As Range
Set nnnn5Range = ws.Range("N5")
If Not nnnn5Range Is Nothing Then
Application.EnableEvents = False: Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
nnnn5Range.FormulaR1C1 = "=RC[1]"
Application.EnableEvents = True: Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
End If
Dim nnnn9nnnn16Range As Range
Set nnnn9nnnn16Range = ws.Range("N9:N16")
If Not nnnn9nnnn16Range Is Nothing Then
Application.EnableEvents = False: Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
nnnn9nnnn16Range.FormulaR1C1 = "=RC[1]"
Application.EnableEvents = True: Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
End If
pRange.Value = 20
End If
ElseIf r5Value <= b3 And r5Value < b1 And r5Value >= b2 And Range("T5").Value = 10 Then
If Not ws.Range("R5").hasFormula Then
Dim rrrr5Range As Range
Set rrrr5Range = ws.Range("R5")
If Not rrrr5Range Is Nothing Then
Application.EnableEvents = False: Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
rrrr5Range.FormulaR1C1 = "=RC[1]"
Application.EnableEvents = True: Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
End If
Dim rrrr9rrrr16Range As Range
Set rrrr9rrrr16Range = ws.Range("R9:R16")
If Not rrrr9rrrr16Range Is Nothing Then
Application.EnableEvents = False: Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
rrrr9rrrr16Range.FormulaR1C1 = "=RC[1]"
Application.EnableEvents = True: Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
End If
tRange.Value = 20
End If
End If
End If
'Action 6
If x1 < Now() And Now() <= z1 Then
If f5Value >= b2 And ws.Range("H5").Value = 20 And ws.Range("F5").Offset(-1, 0).Value < ws.Range("F5").Offset(0, 1).Value Then
If Not ws.Range("F5").hasFormula Then
Dim fffff5Range As Range
Set fffff5Range = ws.Range("F5")
If Not fffff5Range Is Nothing Then
Application.EnableEvents = False: Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
fffff5Range.FormulaR1C1 = "=RC[1]"
Application.EnableEvents = True: Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
End If
Dim fffff9fffff16Range As Range
Set fffff9fffff16Range = ws.Range("F9:F16")
If Not fffff9fffff16Range Is Nothing Then
Application.EnableEvents = False: Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
fffff9fffff16Range.FormulaR1C1 = "=RC[1]"
Application.EnableEvents = True: Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
End If
hRange.Value = 10
End If
ElseIf j5Value >= b2 And ws.Range("L5").Value = 20 And ws.Range("J5").Offset(-1, 0).Value < Range("J5").Offset(0, 1).Value Then
If Not ws.Range("J5").hasFormula Then
Dim jjjjj5Range As Range
Set jjjjj5Range = Range("J5")
If Not jjjjj5Range Is Nothing Then
Application.EnableEvents = False: Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
jjjjj5Range.FormulaR1C1 = "=RC[1]"
Application.EnableEvents = True: Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
End If
Dim jjjjj9jjjjj16Range As Range
Set jjjjj9jjjjj16Range = ws.Range("J9:J16")
If Not jjjjj9jjjjj16Range Is Nothing Then
Application.EnableEvents = False: Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
jjjjj9jjjjj16Range.FormulaR1C1 = "=RC[1]"
Application.EnableEvents = True: Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
End If
lRange.Value = 10
End If
ElseIf n5Value >= b2 And ws.Range("O5").Value = 20 And ws.Range("N5").Offset(-1, 0).Value < ws.Range("N5").Offset(0, 1).Value Then
If Not ws.Range("N5").hasFormula Then
Dim nnnnn5Range As Range
Set nnnnn5Range = ws.Range("N5")
If Not nnnnn5Range Is Nothing Then
Application.EnableEvents = False: Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
nnnnn5Range.FormulaR1C1 = "=RC[1]"
Application.EnableEvents = True: Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
End If
Dim nnnnn9nnnnn16Range As Range
Set nnnnn9nnnnn16Range = ws.Range("N9:N16")
If Not nnnnn9nnnnn16Range Is Nothing Then
Application.EnableEvents = False: Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
nnnnn9nnnnn16Range.FormulaR1C1 = "=RC[1]"
Application.EnableEvents = True: Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
End If
pRange.Value = 10
End If
ElseIf r5Value >= b2 And ws.Range("T5").Value = 20 And ws.Range("R5").Offset(-1, 0).Value < ws.Range("R5").Offset(0, 1).Value Then
If Not ws.Range("R5").hasFormula Then
Dim rrrrr5Range As Range
Set rrrrr5Range = ws.Range("R5")
If Not rrrrr5Range Is Nothing Then
Application.EnableEvents = False: Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
rrrrr5Range.FormulaR1C1 = "=RC[1]"
Application.EnableEvents = True: Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
End If
Dim rrrrr9rrrrr16Range As Range
Set rrrrr9rrrrr16Range = ws.Range("R9:R16")
If Not rrrrr9rrrrr16Range Is Nothing Then
Application.EnableEvents = False: Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
rrrrr9rrrrr16Range.FormulaR1C1 = "=RC[1]"
Application.EnableEvents = True: Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
End If
tRange.Value = 10
End If
End If
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
