Hi,

I'm having trouble with this. The first change occurs but the percentage
change does not. What is wrong?

Also, I have 3 other locations I'd like to check, B28, B29 & B30 and am
unsure how to add them in to the target. How would I do it?

Thanks

Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "B26"
Dim iCtr As Long
Dim sNo As String
Dim sYes As String
Dim sPercentYes As String
Dim sPercentNo As String

Dim LastRow As Long

On Error GoTo ws_exit
Application.EnableEvents = False

If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then

LastRow = 337

If Range("B26").Value = "Yes" Then
For iCtr = 36 To LastRow
'change Pro-Rata Share formula
sYes = "=IF(ISBLANK(R" & iCtr & "C10),"""",IF(R" & iCtr &
"C10" & _
"=""No"",0,IF(ISNUMBER(R" & iCtr & "C16),R" & iCtr & _
"C16,IF(ISBLANK(R6C2),(R" & iCtr & "C11* R" & iCtr & _
"C9),(R" & iCtr & "C11* R" & iCtr &
"C9)/365*(R6C2)))))"
Me.Range("L" & iCtr).FormulaR1C1 = sYes

'change the Pro-Rata Share Percentage formula
sPercentYes = "=IF(ISBLANK(R" & iCtr & "C10),"""",IF(R" &
iCtr & "C10" & "=""No""," & _
"0, Indirect(Vlookup('Line Items'!!$R" & iCtr - 21 &
"C3,CAMPerCentLoc,3,False)))"
Me.Range("K" & iCtr).FormulaR1C1 = sPercentYes
Next
ElseIf Range("B26").Value = "No" Then
For iCtr = 36 To LastRow
'change Pro-Rata Share formula
sNo = "=IF(ISBLANK(R" & iCtr & "C10),"""",IF(R" & iCtr &
"C10" & _
"=""No"",0,IF(ISNUMBER(R" & iCtr & "C16),R" & iCtr & _
"C16,IF(ISBLANK(R6C2),(R" & iCtr & "C11* R" & iCtr & _
"C7),(R" & iCtr & "C11* R" & iCtr & "C7)/365*(R6C2)))))"
Me.Range("L" & iCtr).FormulaR1C1 = sNo

'change the Pro-Rata Share Percentage formula
sPercentNo = "=IF(ISBLANK(R" & iCtr & "C10),""""," & _
"Indirect(Vlookup('Line Items'!!$R" & iCtr - 21 &
"C3,CAMPerCentLoc,3,False)))"
Me.Range("K" & iCtr).FormulaR1C1 = sPercentNo
Next
End If
End If

ws_exit:
Application.EnableEvents = True
End Sub

Hi,

I've gotten B28, B29 & B30 to work but am still unable to get the
percentange formula change to work. I've tried it within the existing code
also looking at B26 and separated it out into it's own If not intersect
statement. (can I have 2 looking at the same cell?) I put in message boxes
to try and determine where it stops. I get the message stating it's in the
percentage section but no other messages so it's stopping at the first item.
I'm not getting any error messages on my code. What is wrong?

Dim sPercentYes As String
Dim sPercentNo As String

If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then

LastRow = 337

MsgBox "Percent Section"
If Range("B26").Value = "Yes" Then
For iCtr = 36 To LastRow
'update the Pro-Rata Share Percentage
sPercentYes = "=IF(ISBLANK(R" & iCtr & "C10),"""",IF(R" &
iCtr & "C10" & "=""No""," & _
"0, Indirect(Vlookup('Line Items'!!$R" & iCtr - 21 &
"C3,CAMPerCentLoc,3,False)))"
Me.Range("K" & iCtr).FormulaR1C1 = sPercentYes
MsgBox "Percent Yes"
Next
ElseIf Range("B26").Value = "No" Then
For iCtr = 36 To LastRow
'update the Pro-Rata Share Percentage
sPercentNo = "=IF(ISBLANK(R" & iCtr & "C10),""""," & _
"Indirect(Vlookup('Line Items'!!$R" & iCtr - 21 &
"C3,CAMPerCentLoc,3,False)))"
Me.Range("K" & iCtr).FormulaR1C1 = sPercentNo
MsgBox "Percent No"
Next
End If
MsgBox "leaving section"
End If



"Karen53" wrote:

Hi,

I'm having trouble with this. The first change occurs but the percentage
change does not. What is wrong?

Also, I have 3 other locations I'd like to check, B28, B29 & B30 and am
unsure how to add them in to the target. How would I do it?

Thanks

Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "B26"
Dim iCtr As Long
Dim sNo As String
Dim sYes As String
Dim sPercentYes As String
Dim sPercentNo As String

Dim LastRow As Long

On Error GoTo ws_exit
Application.EnableEvents = False

If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then

LastRow = 337

If Range("B26").Value = "Yes" Then
For iCtr = 36 To LastRow
'change Pro-Rata Share formula
sYes = "=IF(ISBLANK(R" & iCtr & "C10),"""",IF(R" & iCtr &
"C10" & _
"=""No"",0,IF(ISNUMBER(R" & iCtr & "C16),R" & iCtr & _
"C16,IF(ISBLANK(R6C2),(R" & iCtr & "C11* R" & iCtr & _
"C9),(R" & iCtr & "C11* R" & iCtr &
"C9)/365*(R6C2)))))"
Me.Range("L" & iCtr).FormulaR1C1 = sYes

'change the Pro-Rata Share Percentage formula
sPercentYes = "=IF(ISBLANK(R" & iCtr & "C10),"""",IF(R" &
iCtr & "C10" & "=""No""," & _
"0, Indirect(Vlookup('Line Items'!!$R" & iCtr - 21 &
"C3,CAMPerCentLoc,3,False)))"
Me.Range("K" & iCtr).FormulaR1C1 = sPercentYes
Next
ElseIf Range("B26").Value = "No" Then
For iCtr = 36 To LastRow
'change Pro-Rata Share formula
sNo = "=IF(ISBLANK(R" & iCtr & "C10),"""",IF(R" & iCtr &
"C10" & _
"=""No"",0,IF(ISNUMBER(R" & iCtr & "C16),R" & iCtr & _
"C16,IF(ISBLANK(R6C2),(R" & iCtr & "C11* R" & iCtr & _
"C7),(R" & iCtr & "C11* R" & iCtr & "C7)/365*(R6C2)))))"
Me.Range("L" & iCtr).FormulaR1C1 = sNo

'change the Pro-Rata Share Percentage formula
sPercentNo = "=IF(ISBLANK(R" & iCtr & "C10),""""," & _
"Indirect(Vlookup('Line Items'!!$R" & iCtr - 21 &
"C3,CAMPerCentLoc,3,False)))"
Me.Range("K" & iCtr).FormulaR1C1 = sPercentNo
Next
End If
End If

ws_exit:
Application.EnableEvents = True
End Sub