![]() |
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 |
Help in VBA code
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 |
Help in VBA code
Thanks J, but here is the modification I wanted to make in the codes:
1. rr = every 90 days. so Cells(e.Row, 52) should show how many R&Rs the employee has had or will have within the contract date (c) and end date (which is b) 2. remob = every 366 days. so Cells(e.Row, 53) should show how many remob R&Rs employee has had or will have from the contract date (c) to the end date (b) 3. eligible R&Rs is total of regular R&Rs (rr) and remob that should show up in Cells(e.Row, 51). Can you help mw with this please? 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 |
Help in VBA code
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 |
Help in VBA code
Give me a little time to examine it all in more detail. It might even help
if you could send a copy of the workbook with data in it to me so I can have data to test with. You could send it to (remove spaces) HelpFrom @ JLatham Site .com Of course if it holds confidential/personal info, then I understand. But I still need some time to examine it all and get a more complete understanding of it all. "Gladiator" wrote: Thanks J, but here is the modification I wanted to make in the codes: 1. rr = every 90 days. so Cells(e.Row, 52) should show how many R&Rs the employee has had or will have within the contract date (c) and end date (which is b) 2. remob = every 366 days. so Cells(e.Row, 53) should show how many remob R&Rs employee has had or will have from the contract date (c) to the end date (b) 3. eligible R&Rs is total of regular R&Rs (rr) and remob that should show up in Cells(e.Row, 51). Can you help mw with this please? 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 |
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 |
All times are GMT +1. The time now is 10:24 AM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com