View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
Gladiator Gladiator is offline
external usenet poster
 
Posts: 24
Default Help in VBA code

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