G
Gladiator
Hi All, i am trying to figure out how to modify the code but i cam accross a
few letter i don't know what they are. can you please help me to determine
what these letters are in the below code:
Letter: e, a1, a, b1, b, c1, c, m, rr, rrbc, x
-------Beginning of Code--------------
Private Sub RR_Calculation_Click()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Response = MsgBox(prompt:="Is this POP going to be extended?",
Buttons:=vbYesNo)
If Response = vbYes Then
Ext = 0
Else
Ext = 1
End If
whr = Sheet31.Range("Work_Hours_Requirement")
For Each e In Range("F15:F5000")
a1 = Cells(e.Row, 14)
If IsDate(a1) Then
a = DateValue(a1)
Else
a = 0
End If
b1 = Cells(e.Row, 15)
If IsDate(b1) Then
b = DateValue(b1)
Else
b = 0
End If
c1 = Cells(e.Row, 45)
If IsDate(c1) Then
c = DateValue(c1)
Else
c = 0
End If
m = 0
rr = 0
remob = 0
rrbc = 0
x = 0
If Cells(e.Row, 6).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 and re-run the R&R Calculation!")
Application.Calculation = xlCalculationAutomatic
Exit Sub
ElseIf Left(Cells(e.Row, 6), 3) = "HOU" Or Left(Cells(e.Row, 6), 3)
= "HCN" Or Cells(e.Row, 12).Value < whr 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
If m = 2 Then
c = c + 125
m = 0
x = x + 1
Else
c = c + 120
m = m + 1
x = x + 1
End If
Loop
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 Ext = 1 And x <> 0 Then
If m = 0 Then
remob = remob - 1
Else
rr = rr - 1
End If
rrbc = rrbc + 1
x = x + 1
End If
If m = 2 Then
c = c + 125
remob = remob + 1
m = 0
x = x + 1
Else
c = c + 120
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, 9) = 0 Or Cells(e.Row, 9).Value = "" Then
Cells(e.Row, 46).Value = 0
Cells(e.Row, 47).Value = 0
Cells(e.Row, 48).Value = 0
Cells(e.Row, 52).Value = 0
Else
Cells(e.Row, 46).Value = rr + remob + rrbc
Cells(e.Row, 47).Value = rr
Cells(e.Row, 48).Value = remob
Cells(e.Row, 52).Value = rrbc
End If
Next e
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
MsgBox (" Done!")
End Sub
----------------------End---------------------------
few letter i don't know what they are. can you please help me to determine
what these letters are in the below code:
Letter: e, a1, a, b1, b, c1, c, m, rr, rrbc, x
-------Beginning of Code--------------
Private Sub RR_Calculation_Click()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Response = MsgBox(prompt:="Is this POP going to be extended?",
Buttons:=vbYesNo)
If Response = vbYes Then
Ext = 0
Else
Ext = 1
End If
whr = Sheet31.Range("Work_Hours_Requirement")
For Each e In Range("F15:F5000")
a1 = Cells(e.Row, 14)
If IsDate(a1) Then
a = DateValue(a1)
Else
a = 0
End If
b1 = Cells(e.Row, 15)
If IsDate(b1) Then
b = DateValue(b1)
Else
b = 0
End If
c1 = Cells(e.Row, 45)
If IsDate(c1) Then
c = DateValue(c1)
Else
c = 0
End If
m = 0
rr = 0
remob = 0
rrbc = 0
x = 0
If Cells(e.Row, 6).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 and re-run the R&R Calculation!")
Application.Calculation = xlCalculationAutomatic
Exit Sub
ElseIf Left(Cells(e.Row, 6), 3) = "HOU" Or Left(Cells(e.Row, 6), 3)
= "HCN" Or Cells(e.Row, 12).Value < whr 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
If m = 2 Then
c = c + 125
m = 0
x = x + 1
Else
c = c + 120
m = m + 1
x = x + 1
End If
Loop
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 Ext = 1 And x <> 0 Then
If m = 0 Then
remob = remob - 1
Else
rr = rr - 1
End If
rrbc = rrbc + 1
x = x + 1
End If
If m = 2 Then
c = c + 125
remob = remob + 1
m = 0
x = x + 1
Else
c = c + 120
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, 9) = 0 Or Cells(e.Row, 9).Value = "" Then
Cells(e.Row, 46).Value = 0
Cells(e.Row, 47).Value = 0
Cells(e.Row, 48).Value = 0
Cells(e.Row, 52).Value = 0
Else
Cells(e.Row, 46).Value = rr + remob + rrbc
Cells(e.Row, 47).Value = rr
Cells(e.Row, 48).Value = remob
Cells(e.Row, 52).Value = rrbc
End If
Next e
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
MsgBox (" Done!")
End Sub
----------------------End---------------------------