VBA code to loop formula through worksheet on button click

[caleb123]

I have a relatively simple formula that I'd like to apply to each row in a worksheet upon a command button click. The worksheet has an arbitrary number of rows (could be 2 rows, could be 1,000,000 rows, or anything in between). I'd like the formula to run against all rows that aren't blank. The gist of the formula is that it combines the text from a couple of cells and then searches within that text for a number of keywords, summing up the number of keywords it finds. It then runs a simple calculation based on the ratio of keyword types. Then it moves on to the next row.

Here's the formula:

=SUMPRODUCT( -- ISNUMBER(SEARCH(" "&Table3[Clinical Words]&" ",UPPER(A2&" "&B2))))/SUM(SUMPRODUCT( -- ISNUMBER(SEARCH(" "&Table3[Clinical Words]&" ",UPPER(A2&" "&B2)))),SUMPRODUCT( -- ISNUMBER(SEARCH(" "&Table2[Basic Words]&" ",UPPER(A2&" "&B2)))))*1+SUMPRODUCT( -- ISNUMBER(SEARCH(" "&Table2[Basic Words]&" ",UPPER(A2&" "&B2))))/SUM(SUMPRODUCT( -- ISNUMBER(SEARCH(" "&Table3[Clinical Words]&" ",UPPER(A2&" "&B2)))),SUMPRODUCT( -- ISNUMBER(SEARCH(" "&Table2[Basic Words]&" ",UPPER(A2&" "&B2)))))*4

I don't know VBA so I tried to record a macro where I simply enter the formula into a table cell. However, attempting to run the resulting macro results in an error. "Run-time error '1004': Application-defined or object-defined error" The formula works just fine when manually entered, I just can't get it to work via macro.

The macro as-recorded looks like this:

Sub RLcalc()    ActiveCell.Offset(-7, -3).Range("Table4[[#Headers],[Article Title]]").Select
    ActiveCell.FormulaR1C1 = _
        "=SUMPRODUCT( -- ISNUMBER(SEARCH("" ""&Table3[Clinical Words]&"" "",UPPER(RC[-7]&"" ""&RC[-6]))))/SUM(SUMPRODUCT( -- ISNUMBER(SEARCH("" ""&Table3[Clinical Words]&"" "",UPPER(RC[-7]&"" ""&RC[-6])))),SUMPRODUCT( -- ISNUMBER(SEARCH("" ""&Table2[Basic Words]&"" "",UPPER(RC[-7]&"" ""&RC[-6])))))*1+SUMPRODUCT( -- ISNUMBER(SEARCH("" ""&Table2[Basic Words]&"" "",UPPER(RC[-7]" & _
        "C[-6]))))/SUM(SUMPRODUCT( -- ISNUMBER(SEARCH("" ""&Table3[Clinical Words]&"" "",UPPER(RC[-7]&"" ""&RC[-6])))),SUMPRODUCT( -- ISNUMBER(SEARCH("" ""&Table2[Basic Words]&"" "",UPPER(RC[-7]&"" ""&RC[-6])))))*4"
    ActiveCell.Offset(1, 0).Range("Table4[[#Headers],[Article Title]]").Select
End Sub

My data looks like this:

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Text1[/TD]
[TD]Text2[/TD]
[TD]Optional[/TD]
[TD]Optional[/TD]
[TD]Optional[/TD]
[TD]Optional[/TD]
[TD]Optional[/TD]
[TD]Calculaltion[/TD]
[/TR]
[TR]
[TD]Assessing exertional dyspnea in patients with idiopathic pulmonary fibrosis[/TD]
[TD]Background: Dyspnea is a hallmark symptom of idiopathic pulmonary fibrosis (IPF), and dyspnea induced...etc[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]macro should show calculation results here[/TD]
[/TR]
[TR]
[TD]Survival and predictors of mortality in systemic sclerosis-associated pulmonary arterial hypertension: Outcomes from the pulmonary hypertension assessment and recognition of outcomes in Scleroderma registry[/TD]
[TD]words words words[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]macro should show calculation results here[/TD]
[/TR]
</tbody>[/TABLE]



Thanks!

 

[caleb123]

I tried a different version of the macro script and get the same thing with this:

Sub RLcalc()    
    Range("H2").Select
    ActiveCell.FormulaR1C1 = _
        "=SUMPRODUCT( -- ISNUMBER(SEARCH("" ""&Table3[Clinical Words]&"" "",UPPER(RC[-7]&"" ""&RC[-6]))))/SUM(SUMPRODUCT( -- ISNUMBER(SEARCH("" ""&Table3[Clinical Words]&"" "",UPPER(RC[-7]&"" ""&RC[-6])))),SUMPRODUCT( -- ISNUMBER(SEARCH("" ""&Table2[Basic Words]&"" "",UPPER(RC[-7]&"" ""&RC[-6])))))*1+SUMPRODUCT( -- ISNUMBER(SEARCH("" ""&Table2[Basic Words]&"" "",UPPER(RC[-7]" & _
        "C[-6]))))/SUM(SUMPRODUCT( -- ISNUMBER(SEARCH("" ""&Table3[Clinical Words]&"" "",UPPER(RC[-7]&"" ""&RC[-6])))),SUMPRODUCT( -- ISNUMBER(SEARCH("" ""&Table2[Basic Words]&"" "",UPPER(RC[-7]&"" ""&RC[-6])))))*4"


End Sub

 

[j_unsuitable]

Hey,

I am pretty sure there is an easier way to do that and maybe somebody will come along, but you can def try this:

Sub FillFormula()
Dim rowCount As Long

On Error Resume Next
With ActiveSheet
  rowCount = .Columns("A").SpecialCells(xlCellTypeFormulas, 23).Count
  rowCount = rowCount + .Columns("A").SpecialCells(xlCellTypeConstants, 23).Count
End With

'MsgBox rowCount

Range("H2").Formula = "=YOURFORMULA"
'You need to double up on the quotes inorder to have quotes within the formula

Range("H2").AutoFill Destination:=Range("H2", "H" & rowCount), Type:=xlFillValue

End Sub

Julian

 

[caleb123]

Julian,

That works perfectly. Thank you!