Help in VBA code
in [Programming]
|
From: Gladiator on 1 May 2010 11:33 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
From: JLatham on 1 May 2010 12:47 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
From: Gladiator on 1 May 2010 13:01 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
From: Gladiator on 1 May 2010 15:34 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
From: JLatham on 1 May 2010 18:09
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 |