Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Creating excel file, adding code to it from code, VBE window stays | Excel Programming | |||
How can I modify my code to offset the defined range and repeat theprocedure instead of duplicating my code? | Excel Programming | |||
Run VBA code only worksheet change, but don't trigger worksheet_change event based on what the code does | Excel Programming | |||
Protect Sheet with code, but then code will not Paste error. How do i get around this. Please read for explainations.... | Excel Programming | |||
Excel code convert to Access code - Concat & eliminate duplicates | Excel Programming |