Mammoth Insert Formula

[Karen53]

Hi,

I've been going round and round with this. I don't see what is wrong. The
formula works perfectly in the spreadsheet but it won't let me insert it
programmatically.

original formula
=IF(ISBLANK($J36),"",IF($J36="No",0,IF(ISNUMBER($P42),$P42,IF(ISBLANK($B$6),
_($K42*$G42),($K42*$G42)/365*($B$6)))))

Insert formula
ActiveCell.FormulaR1C1 = "=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)))))"

I get an Application defined or Object defined error.

Thanks.

 

[cubbybear3]

Hi,

I've been going round and round with this. I don't see what is wrong. The
formula works perfectly in the spreadsheet but it won't let me insert it
programmatically.

original formula
=IF(ISBLANK($J36),"",IF($J36="No",0,IF(ISNUMBER($P42),$P42,IF(ISBLANK($B$6)­,
_($K42*$G42),($K42*$G42)/365*($B$6)))))

Insert formula
ActiveCell.FormulaR1C1 = "=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)))))"

I get an Application defined or Object defined error.

Thanks.

It looks to me like your last line "C11)* R" & iCtr & "C9/365*
_(R6C2)))))" needs another double quote before and after the
underline (continuation).

 

[Karen53]

Thanks for the suggestion. I tried it but I'm still getting the same
message. Any other thoughts?

 

[Bob Phillips]

sFormula = "=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)))))"
ActiveCell.FormulaR1C1 = sFormula



--
---
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

 

[Karen53]

Thank you Bob.

I now find it is not waiting for me to make a selection (it's a validation
list). I have others which do not have a for next loop which I have to click
another target cell before it updates. This takes off like a race horse.
This is being called from a Worksheet_Change procedure which when I Step into
I find it goes back up to when I don't expect it to, on the first for next.
It inserted blank cells even though there is a value in column "J". Can you
help me with this? I know the formula works as I had it on the sheet
initially. I need to insert it programmatically.

Thanks

Private Sub Contributions()

Dim iCtr As Long
Dim NoFormula As String
Dim YesFormula As String
Dim LastRow As Long

NoFormula = "=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)))))"

NoFormula = "=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)))))"

LastRow = 0

Call EndRange(LastRow)

If Range("B33").Value = "Yes" Then
For iCtr = 36 To LastRow
Range("L" & iCtr).Select
ActiveCell.FormulaR1C1 = YesFormula
Next
End If

If Range("B33").Value = "No" Then
For iCtr = 36 To LastRow
Range("L" & iCtr).Select
ActiveCell.FormulaR1C1 = NoFormula
Next
End If

End Sub

 

[Karen53]

Note: all I do is click on the cell, I don't make a change and the procedure
runs.

 

[Bob Phillips]

Karen,

I am not sure that I am understanding the issue/problem here, but a couple
of observations.

Your code has two NoFormula declarations, no YesFormula.

You have to re-define the formula each time to make sure it picks up the
current index value, otherwise it will be with an index of 0 for all
iterations.

I also don't like selecting, it causes problems.

Does this do any better?

Private Sub Contributions()
Dim iCtr As Long
Dim NoFormula As String
Dim YesFormula As String
Dim LastRow As Long

LastRow = 0

Call EndRange(LastRow)

If Range("B33").Value = "Yes" Then
For iCtr = 36 To LastRow
YesFormula = "=IF(ISBLANK(R" & iCtr & "C10),"""",IF(R" & iCtr &
"C10" & _
"=""Yes"",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)))))"
Range("L" & iCtr).FormulaR1C1 = YesFormula
Next
ElseIf Range("B33").Value = "No" Then
For iCtr = 36 To LastRow
NoFormula = "=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)))))"
Range("L" & iCtr).FormulaR1C1 = NoFormula
Next
End If

End Sub



--
---
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

 

[Karen53]

Hi Bob,

Thank you! That is much better.

A question though. How do I get the macro to run once I make my selection?
As it is, it runs as soon as I click the cell to select my choice (It's a
validation list). I have to click out of the cell and back on it again for
it to run with the new selection.


Thanks

 

[Bob Phillips]

You mean that you want this macro to run when you make a selection in a Data
Validation with just Yes/No in cell B33,?

Or is it DV in B36 down?
--
---
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

 

[Karen53]

Yes, the yes/no DV is in B33 only. rows 36 down is where the formulas go. No
DV there

Thanks

 

[Bob Phillips]

Okay, give this a whirl

Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "B33"
Dim iCtr As Long
Dim sNo As String
Dim sYes As String
Dim LastRow As Long

On Error GoTo ws_exit
Application.EnableEvents = False

LastRow = 0

Call EndRange(LastRow)

If Range("B33").Value = "Yes" Then
For iCtr = 36 To LastRow
sYes = "=IF(ISBLANK(R" & iCtr & "C10),"""",IF(R" & iCtr & "C10"
& _
"=""Yes"",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)))))"
Range("L" & iCtr).FormulaR1C1 = sYes
Next
ElseIf Range("B33").Value = "No" Then
For iCtr = 36 To LastRow
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 & _
"C9),(R" & iCtr & "C11* R" & iCtr & "C9)/365*(R6C2)))))"
Range("L" & iCtr).FormulaR1C1 = sNo
Next
End If

ws_exit:
Application.EnableEvents = True
End Sub

'This is worksheet event code, which means that it needs to be
'placed in the appropriate worksheet code module, not a standard
'code module. To do this, right-click on the sheet tab, select
'the View Code option from the menu, and paste the code in.

--
---
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

 

[Karen53]

Thanks Bob. I pasted this into the worksheet's module but the formula does
not change when I make a selection. Have I missed something?


Thanks.

 

[Bob Phillips]

Karen,

You have a little routine that calculates the lastrow number. Is that
working correctly, and passing back a row number > 36?

A small modification to make it a bit more efficient

Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "B33"
Dim iCtr As Long
Dim sNo As String
Dim sYes 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 = 0

Call EndRange(LastRow)

If Range("B33").Value = "Yes" Then
For iCtr = 36 To LastRow
sYes = "=IF(ISBLANK(R" & iCtr & "C10),"""",IF(R" & iCtr &
"C10" & _
"=""Yes"",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 = sYes
Next
ElseIf Range("B33").Value = "No" Then
For iCtr = 36 To LastRow
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 & _
"C9),(R" & iCtr & "C11* R" & iCtr &
"C9)/365*(R6C2)))))"
Me.Range("L" & iCtr).FormulaR1C1 = sNo
Next
End If
End If

ws_exit:
Application.EnableEvents = True
End Sub

--
---
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

 

[Karen53]

Hi Dave,

Thank you for helping me with this.

It's still not working for me.

Here is my routine to determine my end row.


Private Sub EndRange(LastRow)

Dim iRow As Long
Dim TopRow As Long
Dim BottomRow As Long

iRow = 0
TopRow = 36
BottomRow = 337

With ActiveSheet

For iRow = BottomRow To TopRow Step -1
If Trim(.Cells(iRow, "E").Text) = "" Then
'keep looking
Else
LastRow = iRow
Exit For
End If

Next iRow

End With

End Sub

 

[Karen53]

Hi Bob,

Sorry, I just noticed I called you Dave. You didn't know you were my
co-worker, did you?

 

[Bob Phillips]

That routine is a tad inefficient but should work assuming that there is
data in that range.

We are at a bit of an impasse, as it works okay in my tests, but not for
real for you.

Any chance that you could send me the workbook to check over?

--
---
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

 

[Bob Phillips]

Bob, Thank you so much! I got it working. It's wonderful!

I had changed the location of the constant and missed changing it in a
location of the code.

I can't get over how great this works! Do you mind if I ask you some
questions? I would like to understand how you did this. Here's what I
think
you did.

You disabled the auto update, right?

I am not sure what you mean by that. It is still a worksheet change event,
so it is still trgiggered by a change to the DV cell.

You set the Target to the entire worksheet?

No. Target is a cell passed to the event procedure by Excel, and I test for
the Target being cell B33, exiting if not, continung if so.

After obtaining the last row you specified which cells you wanted to work
with and what you wanted done.

The code loops through cells B36:Blastrow and processes each dependent upon
what is in the DV cell.

Oh, I think I get it. By disabling the auto update you forced it to wait
for the change, right?

See above.

A question though, the application enable events have been disabled.
Where
are they enabled again? I see where they are enabled if there is an
error.
Yet they are enabled again as the worksheet does update when I make a
change.
Where does that happen?

They are enabled again after the ws_exit label. Events are disabled to stop
change event cascade, and if you notice, before disabling the events, I put
an error trap clause, which goes to ws_exit if there is an error. If an
error is encountered, the code branches to ws_exit, and so events get
re-enabled. If no error is encountered, the code still drops through to
ws_exit, and so events still get re-enabled.

 

[Bob Phillips]

Karen,

In short,

the whole expression has to be enclosed in a single double-quote character
(") at the start and at the end

if you want to evaluate a variable within that expression, you have to close
the string (single double-quote), concatenate the variable ( & varname &),
and then re-open the string (single double-quote)

quotes within the sting itself have to be doubled up, so as to tell the
compiler that it is not the end of the string, but an included quote

if you use a continuation character, you must close the string, add a
concatenation character before the continuation character (" & _), and then
on the next like re-open the string again (single double-quote)

In summary

sNo = "=IF(ISBLANK(R" & iCtr & "C10),"""", _
IF(ISNUMBER(R" & iCtr & "C16),R" & iCtr & _
"C16,IF(R6C2=0,(R" & iCtr & "C11* R" & iCtr & _
"C7),(R" & iCtr & "C11* R" & iCtr &
"C7)/365*(R6C2))))"

becomes

sNo = "=IF(ISBLANK(R" & iCtr & "C10),""""," & _
"IF(ISNUMBER(R" & iCtr & "C16),R" & iCtr & _
"C16,IF(R6C2=0,(R" & iCtr & "C11* R" & iCtr & _
"C7),(R" & iCtr & "C11* R" & iCtr &
"C7)/365*(R6C2))))"

by adding " & before the _ on the first line, and " before the If on the
second line.

--
---
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

 

[Karen53]

Bob,

I had to add another column to update the formula. I understood your
instructions and believe I did it correctly. At least I did not get an error
messeage, but now it is not working. My thought is that perhaps there is
something I need to add because of the Indirect or vloopup statements?

Thanks for your help!

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

'update the Pro-Rata Share Percentage
PercentYes = "=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 = PercentYes
Next
ElseIf Range("B26").Value = "No" Then
For iCtr = 36 To LastRow
'update the Pro-Rata Share formula
CAMNo = "=IF(ISBLANK(R" & iCtr & "C10),"""",IF(R" & iCtr &
"C10" & "=""No""," & _
"IF(ISNUMBER(R" & iCtr & "C16),R" & iCtr & _
"C16,IF(R6C2=0,(R" & iCtr & "C11* R" & iCtr & _
"C7),(R" & iCtr & "C11* R" & iCtr & "C7)/365*(R6C2))))"
Me.Range("L" & iCtr).FormulaR1C1 = CAMNo

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

 

[Karen53]

Bob,

I commented out everything I added and it still is not working. I am
attaching the whole routine. The CAP Yes/Nos work fine but the rest of it
does not. It hesitates like it is doing something but no changes are made.
Could there be anything that would cause it to work intermitantly?

Thanks,
Karen


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 PercentYes As String
'Dim PercentNo 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

' Call EndRange(LastRow)

If Range("B26").Value = "Yes" Then
For iCtr = 36 To LastRow
'update the 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(R6C2=0,(R" & iCtr & "C11* R" & iCtr & _
"C9),(R" & iCtr & "C11* R" & iCtr &
"C9)/365*(R6C2)))))"
Me.Range("L" & iCtr).FormulaR1C1 = sYes

'update the Pro-Rata Share Percentage
' PercentYes = "=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 = PercentYes
Next
ElseIf Range("B26").Value = "No" Then
For iCtr = 36 To LastRow
'update the Pro-Rata Share formula
sNo = "=IF(ISBLANK(R" & iCtr & "C10),"""",IF(R" & iCtr &
"C10" & "=""No""," & _
"IF(ISNUMBER(R" & iCtr & "C16),R" & iCtr & _
"C16,IF(R6C2=0,(R" & iCtr & "C11* R" & iCtr & _
"C7),(R" & iCtr & "C11* R" & iCtr & "C7)/365*(R6C2))))"
Me.Range("L" & iCtr).FormulaR1C1 = sNo

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

'Set the CAP label
'If Range("B28").Value = "Yes" Then
' Range("J23").Value = "CAP"
' Else
' Range("J23").Value = ""
' End If

'Set the Base Year Adj label
'If Range("B29").Value = "Yes" Then
' Range("J24").Value = "Base Year Adj"
'Else
' Range("J24").Value = ""
' End If

'Set the Minimum CAP Label
'If Range("B30").Value = "Yes" Then
' Range("J25").Value = "Minimum CAP"
' Else
' Range("J25").Value = ""
' End If

ws_exit:
Application.EnableEvents = True
End Sub