When application.Calculation is manual do Worksheetfunction.sum willnot function for that part of co

Y

Yuvraj

Hi all,

I am not able to understand what will be the impact of the
Application.Calculation = xlmanual on the code.

Please have a look at the code: For this I have placed
Application.Calculation= xlmanual in the start and I believe that it
will not impact the other functionality in the code. Please give your
view so that I can understand where to swith the calculation to manual
as I am thinking we have WorksheetFunction.Sum() and other functions
when I have switched the calculation mode to manual.

Function d2Test() As Boolean

Dim n%
' Lunch break check
Dim lcel As Range, nolunch As Boolean

'*******************Colleague Entry Change for Commit
Application.Calculation = xlCalculationManual
'End Change

Set kaWks = Worksheets("Details2")
Set rInput = Worksheets("Details2").Range("d4")
fMessage.lbErrors.Clear
For I1 = 21 To [dt2.corep] * 16 + 5 Step 16
For I2 = 1 To 6 Step 5
For i = 0 To 6
If Kround(rInput.offset(i + I1, I2)) = Kround
(rInput.offset(i + I1, I2 + 1)) And Kround(rInput.offset(i + I1, I2 +
2)) = Kround(rInput.offset(i + I1, I2 + 3)) Then
rInput.offset(i + I1, I2).ClearContents
rInput.offset(i + I1, I2 + 3).ClearContents
End If

If (IsEmpty(rInput.offset(i + I1, I2)) = True And
IsEmpty(rInput.offset(i + I1, 3 + I2)) = False) Or (IsEmpty
(rInput.offset(i + I1, I2)) = False And IsEmpty(rInput.offset(i + I1,
3 + I2)) = True) Then
fMessage.lbErrors.AddItem ("Rota " & (I1 - 5) / 16
& " " & rInput.offset(i + I1, 0) & " Available Start/Finish Time
Missing")
rInput.offset(i + I1, I2).Interior.ColorIndex = 3
rInput.offset(i + I1, 3 + I2).Interior.ColorIndex
= 3
End If

If (IsEmpty(rInput.offset(i + I1, I2 + 1)) = True And
IsEmpty(rInput.offset(i + I1, 2 + I2)) = False) Or (IsEmpty
(rInput.offset(i + I1, I2 + 1)) = False And IsEmpty(rInput.offset(i +
I1, 2 + I2)) = True) Then
fMessage.lbErrors.AddItem ("Rota " & (I1 - 5) / 16
& " " & rInput.offset(i + I1, 0) & " Core Start/Finish Time Missing")
rInput.offset(i + I1, 1 + I2).Interior.ColorIndex
= 3
rInput.offset(i + I1, 2 + I2).Interior.ColorIndex
= 3
End If
Next i
Next I2
Next I1

For i = 0 To 1
If IsEmpty(rInput.offset(0, i)) = True Then
rInput.offset(0, i).Interior.ColorIndex = 3
fMessage.lbErrors.AddItem (rInput.offset(-1, i) & "
Missing")
End If
Next i

For i = 2 To 6 Step 2
If IsEmpty(rInput.offset(0, i).Resize(1, 1)) = True Or Len(Trim
(rInput.offset(0, i).Resize(1, 1))) = 0 Then
rInput.offset(0, i).Resize(1, 2).Interior.ColorIndex = 3
fMessage.lbErrors.AddItem (rInput.offset(-1, i) & "
Missing")
End If
Next i

For i = 1 To 3 Step 2
If rInput.offset(0, i).Resize(1, 1) Like "*.*" Or rInput.offset
(0, i).Resize(1, 1) Like ".*" Or rInput.offset(0, i).Resize(1, 1) Like
"*." Then
fMessage.lbErrors.AddItem "A fullstop has been added in
names fields! please remove"
End If
Next i

For i = 2 To 4
If IsEmpty(Range("dt2.Skill" & (i - 1))) = True And IsEmpty
(Range("dt2.Skill" & (i))) = False Then
Range("dt2.skill" & (i - 1)).value = Range("dt2.skill" &
(i)).value
Range("dt2.skill" & (i)).Resize(1, 2).ClearContents
End If
Next i

If IsEmpty(Range("dt2.skill1")) Then
Range("dt2.skill1").Interior.ColorIndex = 3
fMessage.lbErrors.AddItem ("Main task missing")
End If

For i = 0 To 8
If IsEmpty(rInput.offset(8, i)) = True Then
rInput.offset(8, i).Interior.ColorIndex = 3
fMessage.lbErrors.AddItem "Core Contract Details:= " &
rInput.offset(7, i) & " Missing"
End If
Next i

If rInput.offset(8, 1) Like "[SR]" Or rInput.offset(8, 0) = "Y"
Then
For i = 19 To [dt2.corep] * 16 + 3 Step 16
If Kround(rInput.offset(i, 12) + rInput.offset(i, 14)) <>
Kround(rInput.offset(8, 8)) Then
fMessage.lbErrors.AddItem ("Core Contract Details:=
Fixed/RGS/Management contract " & "Rota " & (i - 3) / 16 & " core
hours not equal to contract hours")
kaWks.Range("l12").Interior.ColorIndex = 3
End If
Next i
ElseIf rInput.offset(8, 1) = "F" And rInput.offset(8, 0) = "N"
Then
For i = 19 To [dt2.corep] * 16 + 3 Step 16
If Kround(rInput.offset(i, 12) + rInput.offset(i, 14)) >
Kround(rInput.offset(8, 8) * 0.75) Then
fMessage.lbErrors.AddItem ("Core Contract Details:=
Flexi contract " & "Rota " & (i - 3) / 16 & " Core hours greater than
75% of contract hours")
kaWks.Range("l12").Interior.ColorIndex = 3
End If
Next i
End If

If rInput.offset(12, 8) = 0 Then
fMessage.lbErrors.AddItem "Rota's := " & "No Schedules
entered"
End If


If IsEmpty(rInput.offset(12, 9)) = True And WorksheetFunction.Sum
([dt2.avt]) > 0 Then
rInput.offset(12, 9).Interior.ColorIndex = 3
fMessage.lbErrors.AddItem "Period Rules:= " & rInput.offset
(11, 9) & " missing"
ElseIf WorksheetFunction.Sum([dt2.avt]) = 0 Then
rInput.offset(12, i).ClearContents
End If

For I1 = 17 To [dt2.corep] * 16 + 1 Step 16
If rInput.offset(8, 1) Like "[FR]" Then
If WorksheetFunction.Sum(rInput.offset(I1 + 2, 13),
rInput.offset(I1 + 2, 15)) = 0 And rInput.offset(8, 1) Like "R" Then
On Error Resume Next
rInput.offset(I1, 1).value = rInput.offset(I1 + 2,
16).value
rInput.offset(I1, 2).value = 7 - rInput.offset(I1 + 2,
17).value
rInput.offset(I1, 3).value = rInput.offset(8, 8).value
rInput.offset(I1, 4).value = WorksheetFunction.Small
(rInput.offset(I1 + 4, 12).Resize(7, 4), 1)
rInput.offset(I1, 5).value = WorksheetFunction.Max
(rInput.offset(I1 + 4, 12).Resize(7, 4))
If Year(Date - rInput.offset(8, 5)) - 1900 < 16 Then
rInput.offset(I1, 6).value = Kround(18 / 24)
Else
rInput.offset(I1, 6).value = Kround(11 / 24)
End If
rInput.offset(I1, 7).value = "Y"
rInput.offset(I1, 8).value = "N"
rInput.offset(I1, 9).value = "N"
On Error GoTo 0
End If
For i = 1 To 9
If IsEmpty(rInput.offset(I1, i)) Then
rInput.offset(I1, i).Interior.ColorIndex = 3
fMessage.lbErrors.AddItem ("Rota " & (I1 - 1) / 16
& " " & ":" & rInput.offset(I1 - 1, i) & " missing")
End If
Next i
Else
For i = 1 To 9
rInput.offset(I1, i).ClearContents
Next i
End If
Next I1

If [dt2.corep] > 0 Then
glngDate = CLng((WorksheetFunction.count(kaWks.Range
("f31,f47,f63,f79")) * (4 / [dt2.corep])))

If kaWks.Range("M16") + (glngDate) > 4 Then
kaWks.Range("M16").Interior.ColorIndex = 3
fMessage.lbErrors.AddItem ("Period Rules:= " & "Saturdays
off rule conflict, rota will schedule " & glngDate & " Saturdays")
End If
End If

' Safeway acquisition stores - do not check unpaid break rules
If Not (isStoreInRule("SafewayAcq")) Then
For Each lcel In Range("dt2.lunch")
If (Kround((lcel.offset(0, -1) - lcel.offset(0, -4))
= Kround(6 / 24) And lcel.offset(0, -1) >= Kround(15 / 24) And Kround
Click to expand...
(lcel.offset(0, -4)) <= Kround(11 / 24))) Or _
(Kround(lcel.offset(0, -2) - lcel.offset(0, -3)) >=
Kround(6 / 24) And lcel.offset(0, -2) >= Kround(15 / 24) And Kround
(lcel.offset(0, -3)) <= Kround(11 / 24)) Then
' Do nothing 'GoTo finishcheck
Else
lcel.ClearContents
End If
Next lcel

For I1 = 21 To [dt2.corep] * 16 + 5 Step 16
If IsEmpty(rInput.offset(I1 - 4, 9)) = False And
rInput.offset(I1 - 4, 9) < 7 / 24 Then
rInput.offset(I1, 5).Resize(7, 1).ClearContents
End If
Next I1
End If


If fMessage.lbErrors.ListCount > 0 Then
d2check1 = True
Else
d2check1 = False
End If
'************************Colleague Entry Change for Commit
Application.Calculation = xlCalculationAutomatic
'End Change
End Function


Regards,

Kumar
 
J

Joel

Any time your are comparing cells lie the statement below you need to update
the calculations (only if RInput has changed by the code)

If Kround(rInput.offset(i, 12) + rInput.offset(i, 14)) >
Kround(rInput.offset(8, 8) * 0.75)

Yuvraj said:
Hi all,

I am not able to understand what will be the impact of the
Application.Calculation = xlmanual on the code.

Please have a look at the code: For this I have placed
Application.Calculation= xlmanual in the start and I believe that it
will not impact the other functionality in the code. Please give your
view so that I can understand where to swith the calculation to manual
as I am thinking we have WorksheetFunction.Sum() and other functions
when I have switched the calculation mode to manual.

Function d2Test() As Boolean

Dim n%
' Lunch break check
Dim lcel As Range, nolunch As Boolean

'*******************Colleague Entry Change for Commit
Application.Calculation = xlCalculationManual
'End Change

Set kaWks = Worksheets("Details2")
Set rInput = Worksheets("Details2").Range("d4")
fMessage.lbErrors.Clear
For I1 = 21 To [dt2.corep] * 16 + 5 Step 16
For I2 = 1 To 6 Step 5
For i = 0 To 6
If Kround(rInput.offset(i + I1, I2)) = Kround
(rInput.offset(i + I1, I2 + 1)) And Kround(rInput.offset(i + I1, I2 +
2)) = Kround(rInput.offset(i + I1, I2 + 3)) Then
rInput.offset(i + I1, I2).ClearContents
rInput.offset(i + I1, I2 + 3).ClearContents
End If

If (IsEmpty(rInput.offset(i + I1, I2)) = True And
IsEmpty(rInput.offset(i + I1, 3 + I2)) = False) Or (IsEmpty
(rInput.offset(i + I1, I2)) = False And IsEmpty(rInput.offset(i + I1,
3 + I2)) = True) Then
fMessage.lbErrors.AddItem ("Rota " & (I1 - 5) / 16
& " " & rInput.offset(i + I1, 0) & " Available Start/Finish Time
Missing")
rInput.offset(i + I1, I2).Interior.ColorIndex = 3
rInput.offset(i + I1, 3 + I2).Interior.ColorIndex
= 3
End If

If (IsEmpty(rInput.offset(i + I1, I2 + 1)) = True And
IsEmpty(rInput.offset(i + I1, 2 + I2)) = False) Or (IsEmpty
(rInput.offset(i + I1, I2 + 1)) = False And IsEmpty(rInput.offset(i +
I1, 2 + I2)) = True) Then
fMessage.lbErrors.AddItem ("Rota " & (I1 - 5) / 16
& " " & rInput.offset(i + I1, 0) & " Core Start/Finish Time Missing")
rInput.offset(i + I1, 1 + I2).Interior.ColorIndex
= 3
rInput.offset(i + I1, 2 + I2).Interior.ColorIndex
= 3
End If
Next i
Next I2
Next I1

For i = 0 To 1
If IsEmpty(rInput.offset(0, i)) = True Then
rInput.offset(0, i).Interior.ColorIndex = 3
fMessage.lbErrors.AddItem (rInput.offset(-1, i) & "
Missing")
End If
Next i

For i = 2 To 6 Step 2
If IsEmpty(rInput.offset(0, i).Resize(1, 1)) = True Or Len(Trim
(rInput.offset(0, i).Resize(1, 1))) = 0 Then
rInput.offset(0, i).Resize(1, 2).Interior.ColorIndex = 3
fMessage.lbErrors.AddItem (rInput.offset(-1, i) & "
Missing")
End If
Next i

For i = 1 To 3 Step 2
If rInput.offset(0, i).Resize(1, 1) Like "*.*" Or rInput.offset
(0, i).Resize(1, 1) Like ".*" Or rInput.offset(0, i).Resize(1, 1) Like
"*." Then
fMessage.lbErrors.AddItem "A fullstop has been added in
names fields! please remove"
End If
Next i

For i = 2 To 4
If IsEmpty(Range("dt2.Skill" & (i - 1))) = True And IsEmpty
(Range("dt2.Skill" & (i))) = False Then
Range("dt2.skill" & (i - 1)).value = Range("dt2.skill" &
(i)).value
Range("dt2.skill" & (i)).Resize(1, 2).ClearContents
End If
Next i

If IsEmpty(Range("dt2.skill1")) Then
Range("dt2.skill1").Interior.ColorIndex = 3
fMessage.lbErrors.AddItem ("Main task missing")
End If

For i = 0 To 8
If IsEmpty(rInput.offset(8, i)) = True Then
rInput.offset(8, i).Interior.ColorIndex = 3
fMessage.lbErrors.AddItem "Core Contract Details:= " &
rInput.offset(7, i) & " Missing"
End If
Next i

If rInput.offset(8, 1) Like "[SR]" Or rInput.offset(8, 0) = "Y"
Then
For i = 19 To [dt2.corep] * 16 + 3 Step 16
If Kround(rInput.offset(i, 12) + rInput.offset(i, 14)) <>
Kround(rInput.offset(8, 8)) Then
fMessage.lbErrors.AddItem ("Core Contract Details:=
Fixed/RGS/Management contract " & "Rota " & (i - 3) / 16 & " core
hours not equal to contract hours")
kaWks.Range("l12").Interior.ColorIndex = 3
End If
Next i
ElseIf rInput.offset(8, 1) = "F" And rInput.offset(8, 0) = "N"
Then
For i = 19 To [dt2.corep] * 16 + 3 Step 16
If Kround(rInput.offset(i, 12) + rInput.offset(i, 14)) >
Kround(rInput.offset(8, 8) * 0.75) Then
fMessage.lbErrors.AddItem ("Core Contract Details:=
Flexi contract " & "Rota " & (i - 3) / 16 & " Core hours greater than
75% of contract hours")
kaWks.Range("l12").Interior.ColorIndex = 3
End If
Next i
End If

If rInput.offset(12, 8) = 0 Then
fMessage.lbErrors.AddItem "Rota's := " & "No Schedules
entered"
End If


If IsEmpty(rInput.offset(12, 9)) = True And WorksheetFunction.Sum
([dt2.avt]) > 0 Then
rInput.offset(12, 9).Interior.ColorIndex = 3
fMessage.lbErrors.AddItem "Period Rules:= " & rInput.offset
(11, 9) & " missing"
ElseIf WorksheetFunction.Sum([dt2.avt]) = 0 Then
rInput.offset(12, i).ClearContents
End If

For I1 = 17 To [dt2.corep] * 16 + 1 Step 16
If rInput.offset(8, 1) Like "[FR]" Then
If WorksheetFunction.Sum(rInput.offset(I1 + 2, 13),
rInput.offset(I1 + 2, 15)) = 0 And rInput.offset(8, 1) Like "R" Then
On Error Resume Next
rInput.offset(I1, 1).value = rInput.offset(I1 + 2,
16).value
rInput.offset(I1, 2).value = 7 - rInput.offset(I1 + 2,
17).value
rInput.offset(I1, 3).value = rInput.offset(8, 8).value
rInput.offset(I1, 4).value = WorksheetFunction.Small
(rInput.offset(I1 + 4, 12).Resize(7, 4), 1)
rInput.offset(I1, 5).value = WorksheetFunction.Max
(rInput.offset(I1 + 4, 12).Resize(7, 4))
If Year(Date - rInput.offset(8, 5)) - 1900 < 16 Then
rInput.offset(I1, 6).value = Kround(18 / 24)
Else
rInput.offset(I1, 6).value = Kround(11 / 24)
End If
rInput.offset(I1, 7).value = "Y"
rInput.offset(I1, 8).value = "N"
rInput.offset(I1, 9).value = "N"
On Error GoTo 0
End If
For i = 1 To 9
If IsEmpty(rInput.offset(I1, i)) Then
rInput.offset(I1, i).Interior.ColorIndex = 3
fMessage.lbErrors.AddItem ("Rota " & (I1 - 1) / 16
& " " & ":" & rInput.offset(I1 - 1, i) & " missing")
End If
Next i
Else
For i = 1 To 9
rInput.offset(I1, i).ClearContents
Next i
End If
Next I1

If [dt2.corep] > 0 Then
glngDate = CLng((WorksheetFunction.count(kaWks.Range
("f31,f47,f63,f79")) * (4 / [dt2.corep])))

If kaWks.Range("M16") + (glngDate) > 4 Then
kaWks.Range("M16").Interior.ColorIndex = 3
fMessage.lbErrors.AddItem ("Period Rules:= " & "Saturdays
off rule conflict, rota will schedule " & glngDate & " Saturdays")
End If
End If

' Safeway acquisition stores - do not check unpaid break rules
If Not (isStoreInRule("SafewayAcq")) Then
For Each lcel In Range("dt2.lunch")
If (Kround((lcel.offset(0, -1) - lcel.offset(0, -4))
= Kround(6 / 24) And lcel.offset(0, -1) >= Kround(15 / 24) And Kround
Click to expand...
(lcel.offset(0, -4)) <= Kround(11 / 24))) Or _
(Kround(lcel.offset(0, -2) - lcel.offset(0, -3)) >=
Kround(6 / 24) And lcel.offset(0, -2) >= Kround(15 / 24) And Kround
(lcel.offset(0, -3)) <= Kround(11 / 24)) Then
' Do nothing 'GoTo finishcheck
Else
lcel.ClearContents
End If
Next lcel

For I1 = 21 To [dt2.corep] * 16 + 5 Step 16
If IsEmpty(rInput.offset(I1 - 4, 9)) = False And
rInput.offset(I1 - 4, 9) < 7 / 24 Then
rInput.offset(I1, 5).Resize(7, 1).ClearContents
End If
Next I1
End If


If fMessage.lbErrors.ListCount > 0 Then
d2check1 = True
Else
d2check1 = False
End If
'************************Colleague Entry Change for Commit
Application.Calculation = xlCalculationAutomatic
'End Change
End Function


Regards,

Kumar
Click to expand...
 
Y

Yuvraj

Any time your are comparing cells lie the statement below you need to update
the calculations (only if RInput has changed by the code)

If Kround(rInput.offset(i, 12) + rInput.offset(i, 14)) >
Kround(rInput.offset(8, 8) * 0.75)



Yuvraj said:
Hi all,
Click to expand...
I am not able to understand what will be the impact of the
Application.Calculation = xlmanual on the code.
Click to expand...
Please have a look at the code: For this I have placed
Application.Calculation= xlmanual in the start and I believe that it
will not impact the other functionality in the code. Please give your
view so that I can understand where to swith the calculation to manual
as I am thinking we have WorksheetFunction.Sum() and other functions
when I have switched the calculation mode to manual.
Click to expand...
Function d2Test() As Boolean
Click to expand...
    Dim n%
'   Lunch break check
    Dim lcel As Range, nolunch As Boolean
Click to expand...
    '*******************Colleague Entry Change for Commit
    Application.Calculation = xlCalculationManual
    'End Change
Click to expand...
    Set kaWks = Worksheets("Details2")
    Set rInput = Worksheets("Details2").Range("d4")
    fMessage.lbErrors.Clear
    For I1 = 21 To [dt2.corep] * 16 + 5 Step 16
        For I2 = 1 To 6 Step 5
            For i = 0 To 6
                If Kround(rInput.offset(i + I1, I2)) = Kround
(rInput.offset(i + I1, I2 + 1)) And Kround(rInput.offset(i + I1, I2 +
2)) = Kround(rInput.offset(i + I1, I2 + 3)) Then
                    rInput.offset(i + I1, I2).ClearContents
                    rInput.offset(i + I1, I2 + 3).ClearContents
                End If
Click to expand...
                If (IsEmpty(rInput.offset(i + I1, I2)) = True And
IsEmpty(rInput.offset(i + I1, 3 + I2)) = False) Or (IsEmpty
(rInput.offset(i + I1, I2)) = False And IsEmpty(rInput.offset(i + I1,
3 + I2)) = True) Then
                    fMessage.lbErrors.AddItem ("Rota " & (I1 - 5) / 16
& " " & rInput.offset(i + I1, 0) & " Available Start/Finish Time
Missing")
                    rInput.offset(i + I1, I2).Interior.ColorIndex = 3
                    rInput.offset(i + I1, 3 + I2).Interior.ColorIndex
= 3
                End If
Click to expand...
                If (IsEmpty(rInput.offset(i + I1, I2 + 1)) = True And
IsEmpty(rInput.offset(i + I1, 2 + I2)) = False) Or (IsEmpty
(rInput.offset(i + I1, I2 + 1)) = False And IsEmpty(rInput.offset(i +
I1, 2 + I2)) = True) Then
                    fMessage.lbErrors.AddItem ("Rota " & (I1 - 5) / 16
& " " & rInput.offset(i + I1, 0) & " Core Start/Finish Time Missing")
                    rInput.offset(i + I1, 1 + I2).Interior.ColorIndex
= 3
                    rInput.offset(i + I1, 2 + I2).Interior.ColorIndex
= 3
                End If
            Next i
        Next I2
    Next I1
Click to expand...
    For i = 0 To 1
        If IsEmpty(rInput.offset(0, i)) = True Then
            rInput.offset(0, i).Interior.ColorIndex = 3
            fMessage.lbErrors.AddItem (rInput.offset(-1, i)& "
Missing")
        End If
    Next i
Click to expand...
    For i = 2 To 6 Step 2
        If IsEmpty(rInput.offset(0, i).Resize(1, 1)) = True Or Len(Trim
(rInput.offset(0, i).Resize(1, 1))) = 0 Then
            rInput.offset(0, i).Resize(1, 2).Interior.ColorIndex = 3
            fMessage.lbErrors.AddItem (rInput.offset(-1, i)& "
Missing")
        End If
    Next i
Click to expand...
    For i = 1 To 3 Step 2
        If rInput.offset(0, i).Resize(1, 1) Like "*.*" Or rInput.offset
(0, i).Resize(1, 1) Like ".*" Or rInput.offset(0, i).Resize(1, 1) Like
"*." Then
            fMessage.lbErrors.AddItem "A fullstop has been added in
names fields! please remove"
        End If
    Next i
Click to expand...
    For i = 2 To 4
        If IsEmpty(Range("dt2.Skill" & (i - 1))) = True And IsEmpty
(Range("dt2.Skill" & (i))) = False Then
            Range("dt2.skill" & (i - 1)).value = Range("dt2.skill" &
(i)).value
            Range("dt2.skill" & (i)).Resize(1, 2).ClearContents
        End If
    Next i
Click to expand...
    If IsEmpty(Range("dt2.skill1")) Then
        Range("dt2.skill1").Interior.ColorIndex = 3
        fMessage.lbErrors.AddItem ("Main task missing")
    End If
Click to expand...
    For i = 0 To 8
        If IsEmpty(rInput.offset(8, i)) = True Then
            rInput.offset(8, i).Interior.ColorIndex = 3
            fMessage.lbErrors.AddItem "Core Contract Details:= " &
rInput.offset(7, i) & " Missing"
        End If
    Next i
Click to expand...
    If rInput.offset(8, 1) Like "[SR]" Or rInput.offset(8, 0) = "Y"
Then
        For i = 19 To [dt2.corep] * 16 + 3 Step 16
            If Kround(rInput.offset(i, 12) + rInput.offset(i, 14)) <>
Kround(rInput.offset(8, 8)) Then
                fMessage.lbErrors.AddItem ("Core Contract Details:=
Fixed/RGS/Management contract " & "Rota " & (i - 3) / 16 & "  core
hours not equal to contract hours")
                kaWks.Range("l12").Interior.ColorIndex = 3
            End If
        Next i
    ElseIf rInput.offset(8, 1) = "F" And rInput.offset(8, 0) = "N"
Then
        For i = 19 To [dt2.corep] * 16 + 3 Step 16
            If Kround(rInput.offset(i, 12) + rInput.offset(i, 14)) >
Kround(rInput.offset(8, 8) * 0.75) Then
                fMessage.lbErrors.AddItem ("Core Contract Details:=
Flexi contract " & "Rota " & (i - 3) / 16 & "  Core hours greater than
75% of contract hours")
                kaWks.Range("l12").Interior.ColorIndex = 3
            End If
        Next i
    End If
Click to expand...
    If rInput.offset(12, 8) = 0 Then
        fMessage.lbErrors.AddItem "Rota's := " & "No Schedules
entered"
    End If
Click to expand...
    If IsEmpty(rInput.offset(12, 9)) = True And WorksheetFunction..Sum
([dt2.avt]) > 0 Then
        rInput.offset(12, 9).Interior.ColorIndex = 3
        fMessage.lbErrors.AddItem "Period Rules:= " & rInput.offset
(11, 9) & " missing"
    ElseIf WorksheetFunction.Sum([dt2.avt]) = 0 Then
        rInput.offset(12, i).ClearContents
    End If
Click to expand...
    For I1 = 17 To [dt2.corep] * 16 + 1 Step 16
        If rInput.offset(8, 1) Like "[FR]" Then
            If WorksheetFunction.Sum(rInput.offset(I1 + 2, 13),
rInput.offset(I1 + 2, 15)) = 0 And rInput.offset(8, 1) Like "R" Then
            On Error Resume Next
            rInput.offset(I1, 1).value = rInput.offset(I1+ 2,
16).value
            rInput.offset(I1, 2).value = 7 - rInput.offset(I1 + 2,
17).value
            rInput.offset(I1, 3).value = rInput.offset(8,8).value
            rInput.offset(I1, 4).value = WorksheetFunction.Small
(rInput.offset(I1 + 4, 12).Resize(7, 4), 1)
            rInput.offset(I1, 5).value = WorksheetFunction.Max
(rInput.offset(I1 + 4, 12).Resize(7, 4))
                If Year(Date - rInput.offset(8, 5)) - 1900 < 16 Then
                rInput.offset(I1, 6).value = Kround(18 / 24)
                Else
                rInput.offset(I1, 6).value = Kround(11 / 24)
                End If
            rInput.offset(I1, 7).value = "Y"
            rInput.offset(I1, 8).value = "N"
            rInput.offset(I1, 9).value = "N"
            On Error GoTo 0
            End If
            For i = 1 To 9
                If IsEmpty(rInput.offset(I1, i)) Then
                    rInput.offset(I1, i).Interior.ColorIndex = 3
                    fMessage.lbErrors.AddItem ("Rota " & (I1 - 1) / 16
& " " & ":" & rInput.offset(I1 - 1, i) & "  missing")
                End If
            Next i
        Else
            For i = 1 To 9
                rInput.offset(I1, i).ClearContents
            Next i
        End If
    Next I1
Click to expand...
    If [dt2.corep] > 0 Then
        glngDate = CLng((WorksheetFunction.count(kaWks.Range
("f31,f47,f63,f79")) * (4 / [dt2.corep])))
Click to expand...
        If kaWks.Range("M16") + (glngDate) > 4 Then
            kaWks.Range("M16").Interior.ColorIndex = 3
            fMessage.lbErrors.AddItem ("Period Rules:= " & "Saturdays
off rule conflict, rota will schedule " & glngDate & " Saturdays")
        End If
    End If
Click to expand...
'   Safeway acquisition stores - do not check unpaid break rules
        If Not (isStoreInRule("SafewayAcq")) Then
            For Each lcel In Range("dt2.lunch")
                If (Kround((lcel.offset(0, -1) - lcel.offset(0, -4))
(lcel.offset(0, -4)) <= Kround(11 / 24))) Or _
                (Kround(lcel.offset(0, -2) - lcel.offset(0, -3)) >=
Kround(6 / 24) And lcel.offset(0, -2) >= Kround(15 / 24) And Kround
(lcel.offset(0, -3)) <= Kround(11 / 24)) Then
                    ' Do nothing    'GoTo finishcheck
                Else
                    lcel.ClearContents
                End If
            Next lcel
Click to expand...
            For I1 = 21 To [dt2.corep] * 16 + 5 Step 16
                If IsEmpty(rInput.offset(I1 - 4, 9)) = False And
rInput.offset(I1 - 4, 9) < 7 / 24 Then
                    rInput.offset(I1, 5).Resize(7, 1).ClearContents
                End If
            Next I1
        End If
Click to expand...
    If fMessage.lbErrors.ListCount > 0 Then
        d2check1 = True
    Else
        d2check1 = False
    End If
 '************************Colleague Entry Change for Commit
    Application.Calculation = xlCalculationAutomatic
    'End Change
End Function

Kumar- Hide quoted text -
Click to expand...

- Show quoted text -
Click to expand...


Thanx for your reply but as i understand that if the rinput is
changinging by code then i need to switch to calculation automatic.
I would explain a bit here rinput is the employee badge number with
which i am offsetting hence the code here runs when i commit change
particular to an employee. Hence during this code execution the rinput
will be the badge number which should not change till the change is
committed. hence what about these pice of code

For I1 = 17 To [dt2.corep] * 16 + 1 Step 16
If rInput.offset(8, 1) Like "[FR]" Then
/**************will not this be effected if calculation is set to
manual ?????????????
If WorksheetFunction.Sum(rInput.offset(I1 + 2, 13),
rInput.offset(I1 + 2, 15)) = 0 And rInput.offset(8, 1) Like "R" Then
On Error Resume Next
/************Will not this be effected?????????????
rInput.offset(I1, 1).value = rInput.offset(I1 + 2,
16).value
rInput.offset(I1, 2).value = 7 - rInput.offset(I1 + 2,
17).value
rInput.offset(I1, 3).value = rInput.offset(8, 8).value
rInput.offset(I1, 4).value = WorksheetFunction.Small
(rInput.offset(I1 + 4, 12).Resize(7, 4), 1)
rInput.offset(I1, 5).value = WorksheetFunction.Max
(rInput.offset(I1 + 4, 12).Resize(7, 4))
If Year(Date - rInput.offset(8, 5)) - 1900 < 16 Then
rInput.offset(I1, 6).value = Kround(18 / 24)
Else
rInput.offset(I1, 6).value = Kround(11 / 24)
End If


Also it will be very kind of you if you explain this and also the
above line in ur previous mail.

I have given you my understanding from your answer of the mail.

Regards,

Kumar
 
J

Joel

It depends if the cells are formulas (or references to other cells = A5).

The following line is a test and may not be correct with calculations off

If rInput.offset(8, 1) Like "[FR]" Then

Straight equates like the following won't be affected except if later in the
code there is a test checking the value of the cells.

rInput.offset(I1, 1).value = rInput.offset(I1 + 2,
16).value





Joel said:
Any time your are comparing cells lie the statement below you need to update
the calculations (only if RInput has changed by the code)

If Kround(rInput.offset(i, 12) + rInput.offset(i, 14)) >
Kround(rInput.offset(8, 8) * 0.75)

Yuvraj said:
Hi all,

I am not able to understand what will be the impact of the
Application.Calculation = xlmanual on the code.

Please have a look at the code: For this I have placed
Application.Calculation= xlmanual in the start and I believe that it
will not impact the other functionality in the code. Please give your
view so that I can understand where to swith the calculation to manual
as I am thinking we have WorksheetFunction.Sum() and other functions
when I have switched the calculation mode to manual.

Function d2Test() As Boolean

Dim n%
' Lunch break check
Dim lcel As Range, nolunch As Boolean

'*******************Colleague Entry Change for Commit
Application.Calculation = xlCalculationManual
'End Change

Set kaWks = Worksheets("Details2")
Set rInput = Worksheets("Details2").Range("d4")
fMessage.lbErrors.Clear
For I1 = 21 To [dt2.corep] * 16 + 5 Step 16
For I2 = 1 To 6 Step 5
For i = 0 To 6
If Kround(rInput.offset(i + I1, I2)) = Kround
(rInput.offset(i + I1, I2 + 1)) And Kround(rInput.offset(i + I1, I2 +
2)) = Kround(rInput.offset(i + I1, I2 + 3)) Then
rInput.offset(i + I1, I2).ClearContents
rInput.offset(i + I1, I2 + 3).ClearContents
End If

If (IsEmpty(rInput.offset(i + I1, I2)) = True And
IsEmpty(rInput.offset(i + I1, 3 + I2)) = False) Or (IsEmpty
(rInput.offset(i + I1, I2)) = False And IsEmpty(rInput.offset(i + I1,
3 + I2)) = True) Then
fMessage.lbErrors.AddItem ("Rota " & (I1 - 5) / 16
& " " & rInput.offset(i + I1, 0) & " Available Start/Finish Time
Missing")
rInput.offset(i + I1, I2).Interior.ColorIndex = 3
rInput.offset(i + I1, 3 + I2).Interior.ColorIndex
= 3
End If

If (IsEmpty(rInput.offset(i + I1, I2 + 1)) = True And
IsEmpty(rInput.offset(i + I1, 2 + I2)) = False) Or (IsEmpty
(rInput.offset(i + I1, I2 + 1)) = False And IsEmpty(rInput.offset(i +
I1, 2 + I2)) = True) Then
fMessage.lbErrors.AddItem ("Rota " & (I1 - 5) / 16
& " " & rInput.offset(i + I1, 0) & " Core Start/Finish Time Missing")
rInput.offset(i + I1, 1 + I2).Interior.ColorIndex
= 3
rInput.offset(i + I1, 2 + I2).Interior.ColorIndex
= 3
End If
Next i
Next I2
Next I1

For i = 0 To 1
If IsEmpty(rInput.offset(0, i)) = True Then
rInput.offset(0, i).Interior.ColorIndex = 3
fMessage.lbErrors.AddItem (rInput.offset(-1, i) & "
Missing")
End If
Next i

For i = 2 To 6 Step 2
If IsEmpty(rInput.offset(0, i).Resize(1, 1)) = True Or Len(Trim
(rInput.offset(0, i).Resize(1, 1))) = 0 Then
rInput.offset(0, i).Resize(1, 2).Interior.ColorIndex = 3
fMessage.lbErrors.AddItem (rInput.offset(-1, i) & "
Missing")
End If
Next i

For i = 1 To 3 Step 2
If rInput.offset(0, i).Resize(1, 1) Like "*.*" Or rInput.offset
(0, i).Resize(1, 1) Like ".*" Or rInput.offset(0, i).Resize(1, 1) Like
"*." Then
fMessage.lbErrors.AddItem "A fullstop has been added in
names fields! please remove"
End If
Next i

For i = 2 To 4
If IsEmpty(Range("dt2.Skill" & (i - 1))) = True And IsEmpty
(Range("dt2.Skill" & (i))) = False Then
Range("dt2.skill" & (i - 1)).value = Range("dt2.skill" &
(i)).value
Range("dt2.skill" & (i)).Resize(1, 2).ClearContents
End If
Next i

If IsEmpty(Range("dt2.skill1")) Then
Range("dt2.skill1").Interior.ColorIndex = 3
fMessage.lbErrors.AddItem ("Main task missing")
End If

For i = 0 To 8
If IsEmpty(rInput.offset(8, i)) = True Then
rInput.offset(8, i).Interior.ColorIndex = 3
fMessage.lbErrors.AddItem "Core Contract Details:= " &
rInput.offset(7, i) & " Missing"
End If
Next i

If rInput.offset(8, 1) Like "[SR]" Or rInput.offset(8, 0) = "Y"
Then
For i = 19 To [dt2.corep] * 16 + 3 Step 16
If Kround(rInput.offset(i, 12) + rInput.offset(i, 14)) <>
Kround(rInput.offset(8, 8)) Then
fMessage.lbErrors.AddItem ("Core Contract Details:=
Fixed/RGS/Management contract " & "Rota " & (i - 3) / 16 & " core
hours not equal to contract hours")
kaWks.Range("l12").Interior.ColorIndex = 3
End If
Next i
ElseIf rInput.offset(8, 1) = "F" And rInput.offset(8, 0) = "N"
Then
For i = 19 To [dt2.corep] * 16 + 3 Step 16
If Kround(rInput.offset(i, 12) + rInput.offset(i, 14)) >
Kround(rInput.offset(8, 8) * 0.75) Then
fMessage.lbErrors.AddItem ("Core Contract Details:=
Flexi contract " & "Rota " & (i - 3) / 16 & " Core hours greater than
75% of contract hours")
kaWks.Range("l12").Interior.ColorIndex = 3
End If
Next i
End If

If rInput.offset(12, 8) = 0 Then
fMessage.lbErrors.AddItem "Rota's := " & "No Schedules
entered"
End If


If IsEmpty(rInput.offset(12, 9)) = True And WorksheetFunction.Sum
([dt2.avt]) > 0 Then
rInput.offset(12, 9).Interior.ColorIndex = 3
fMessage.lbErrors.AddItem "Period Rules:= " & rInput.offset
(11, 9) & " missing"
ElseIf WorksheetFunction.Sum([dt2.avt]) = 0 Then
rInput.offset(12, i).ClearContents
End If

For I1 = 17 To [dt2.corep] * 16 + 1 Step 16
If rInput.offset(8, 1) Like "[FR]" Then
If WorksheetFunction.Sum(rInput.offset(I1 + 2, 13),
rInput.offset(I1 + 2, 15)) = 0 And rInput.offset(8, 1) Like "R" Then
On Error Resume Next
rInput.offset(I1, 1).value = rInput.offset(I1 + 2,
16).value
rInput.offset(I1, 2).value = 7 - rInput.offset(I1 + 2,
17).value
rInput.offset(I1, 3).value = rInput.offset(8, 8).value
rInput.offset(I1, 4).value = WorksheetFunction.Small
(rInput.offset(I1 + 4, 12).Resize(7, 4), 1)
rInput.offset(I1, 5).value = WorksheetFunction.Max
(rInput.offset(I1 + 4, 12).Resize(7, 4))
If Year(Date - rInput.offset(8, 5)) - 1900 < 16 Then
rInput.offset(I1, 6).value = Kround(18 / 24)
Else
rInput.offset(I1, 6).value = Kround(11 / 24)
End If
rInput.offset(I1, 7).value = "Y"
rInput.offset(I1, 8).value = "N"
rInput.offset(I1, 9).value = "N"
On Error GoTo 0
End If
For i = 1 To 9
If IsEmpty(rInput.offset(I1, i)) Then
rInput.offset(I1, i).Interior.ColorIndex = 3
fMessage.lbErrors.AddItem ("Rota " & (I1 - 1) / 16
& " " & ":" & rInput.offset(I1 - 1, i) & " missing")
End If
Next i
Else
For i = 1 To 9
rInput.offset(I1, i).ClearContents
Next i
End If
Next I1

If [dt2.corep] > 0 Then
glngDate = CLng((WorksheetFunction.count(kaWks.Range
("f31,f47,f63,f79")) * (4 / [dt2.corep])))

If kaWks.Range("M16") + (glngDate) > 4 Then
kaWks.Range("M16").Interior.ColorIndex = 3
fMessage.lbErrors.AddItem ("Period Rules:= " & "Saturdays
off rule conflict, rota will schedule " & glngDate & " Saturdays")
End If
End If

' Safeway acquisition stores - do not check unpaid break rules
If Not (isStoreInRule("SafewayAcq")) Then
For Each lcel In Range("dt2.lunch")
If (Kround((lcel.offset(0, -1) - lcel.offset(0, -4))
= Kround(6 / 24) And lcel.offset(0, -1) >= Kround(15 / 24) And Kround
Click to expand...
(lcel.offset(0, -4)) <= Kround(11 / 24))) Or _
(Kround(lcel.offset(0, -2) - lcel.offset(0, -3)) >=
Kround(6 / 24) And lcel.offset(0, -2) >= Kround(15 / 24) And Kround
(lcel.offset(0, -3)) <= Kround(11 / 24)) Then
' Do nothing 'GoTo finishcheck
Else
lcel.ClearContents
End If
Next lcel

For I1 = 21 To [dt2.corep] * 16 + 5 Step 16
If IsEmpty(rInput.offset(I1 - 4, 9)) = False And
rInput.offset(I1 - 4, 9) < 7 / 24 Then
rInput.offset(I1, 5).Resize(7, 1).ClearContents
End If
Next I1
End If


If fMessage.lbErrors.ListCount > 0 Then
d2check1 = True
Else
d2check1 = False
End If
'************************Colleague Entry Change for Commit
Application.Calculation = xlCalculationAutomatic
'End Change
End Function


Regards,

Kumar
Click to expand...
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Conditions when we can set the excel code calculations to manual andwhen we should not 3
Word macro that can call cells out of Excel for a find and replace 0
Can this be done with HIDE - UNHIDE ? 4
Type Mismatch error when trying to generically set ComboBox to aComboBox variable 8
Change a Macro - Copy in Columns instead of copy in Rows 7
Displaing result in Entire worksheet 4
Q on integer, little endian, LSet, data formats, .. 4
Working in Excel 2003 but not Excel 2007. Can not protect sheet. 2

Top