Help in VBA code
m and x appear to be counters that are used to control which of the If ...
Then statements will execute to calculate the R&R time. If the Do Loop
executes twice with the criteria that adds one to the value of m or x, as
the case may be, then the value of m or rr will equal 2 and the Else part of
the If ... Then statement executes and resets the m to 0. The x value is
reset to 0 in each For ... Each loop.
"Gladiator" wrote in message
...
J, can you please explain in a more spesific way so that I can try to
solve
it myself? Greatly appreciate any help. Thanks.
"JLatham" wrote:
m and x appear to be simple counters, incrementing with certain
conditions
are met and other values are also updated. Since they are only tested
for
zero or non-zero late in the process, they're just acting as flags to
indicate whethere any cells in either group were processed earlier.
"Gladiator" wrote:
All,
I am new to VBA. I have an xl sheet where it has the code that
calculates
vacation (R&R) times for employees. The code was written by a person
who left
the company a long time ago. But I need to make some modifications to
the
code and cannot fiure out how it calculates. I was able to figure out
what
'a', 'b', and 'c' are in the code though. Like Remob happens every 366
days
from the contract date, that mean every 366 dyas an employee will get
1.
Regular R&Rs are taken every 90 days, that means 1 every 90 days and
Reg RRs
are the R&Rs other than Remob ones. Eligible R&Rs is Reg RR + Remob. I
cannot
figure out what "m" and "x" are? Thanks in advance.
Private Sub RR_Calculation_Click()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Response = MsgBox(prompt:="Proceed with running R&R computation?",
Buttons:=vbYesNo)
If Response = vbYes Then
Ext = 0
Else
Exit Sub
End If
For Each e In Range("D14:D3000")
a1 = Cells(e.Row, 23) 'st date
If IsDate(a1) Then
a = DateValue(a1)
Else
a = 0
End If
b1 = Cells(e.Row, 24) 'end date
If IsDate(b1) Then
b = DateValue(b1)
Else
b = 0
End If
c1 = Cells(e.Row, 16) 'contr date
If IsDate(c1) Then
c = DateValue(c1)
Else
c = 0
End If
SAP = Cells(e.Row, 8)
m = 0
rr = 0
remob = 0
x = 0
If Cells(e.Row, 4).Value < "" Then
If a = 0 Or b = 0 Or a b Or a = b Or Not IsDate(a) Or Not
IsDate(b) Or a1 < a Or b1 < b Then
MsgBox ("Please correct ETC Start and End dates (row " &
e.Row &
") and re-run the R&R Calculation!")
Application.Calculation = xlCalculationAutomatic
Exit Sub
ElseIf Right(Cells(e.Row, 4), 2) = "LN" Then
ElseIf c = 0 Or b = c Or Not IsDate(c) Or c1 < c Then
MsgBox ("Please correct the Contract date (row " & e.Row &
")
and re-run the R&R Calculation!")
Application.Calculation = xlCalculationAutomatic
Exit Sub
Else
Do While c < a 'Contr date < St Date
If m = 2 Then
c = c + 95
m = 0
x = x + 1
Else
c = c + 90
m = m + 1
x = x + 1
End If
Loop
'If Cells(e.Row, 49).Value = 2 Then
If x < 0 Then
If m = 0 Then
remob = remob + 1
Else
rr = rr + 1
End If
End If
Do While c <= b + 1
If b + 1 - c < 30 And x < 0 Then
If m = 0 Then
remob = remob - 1
Else
rr = rr - 1
End If
x = x + 1
End If
If m = 2 Then
c = c + 90
remob = remob + 1
m = 0
x = x + 1
Else
c = c + 90
rr = rr + 1
m = m + 1
x = x + 1
End If
Loop
If m = 0 And x < 0 Then
remob = remob - 1
ElseIf x < 0 Then
rr = rr - 1
End If
End If
End If
If Cells(e.Row, 11) = 0 Or Cells(e.Row, 11).Value = "" Then
Cells(e.Row, 51).Value = 0 'Eligible R&Rs
Cells(e.Row, 52).Value = 0 'Regular R&R
Cells(e.Row, 53).Value = 0 'Remob R&R
Else
Cells(e.Row, 51).Value = rr + remob
Cells(e.Row, 52).Value = rr
Cells(e.Row, 53).Value = remob
'Eligible R&Rs = rr + remob + rrbc
'Reg R&R = rr
'Remob R&R = remob
End If
Next e
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
MsgBox (" Done!")
End Sub
|