Long Array Formulas Using VBA

**jiver1** · 12-19-2013, 01:45 PM

I am trying to get the following long array into a vba sub procedure, however it continues to give the 'cannot set the formula array into the range class' error despite each of the pieces being less than 255 characters. Any help would be appreciated.

Thanks.

Dim rows As Long
    Dim rows1 As Long
    Dim form1 As String
    Dim form2 As String
    Dim form3 As String
                    
    rows = Worksheets("EOD t-1").Range("H1").End(xlDown).Row
    rows1 = ActiveSheet.Range("G1").End(xlDown).Row
        
    form1 = "=IF(RC[-2]=0,SUM(IF(FREQUENCY(IF('EOD t-1'!R2C1:R" & rows & "C1=EOD!RC[-7],IF('EOD t-1'!R2C3:R" & rows & "C3=RC[-5]," & _
            "X_X())" & _
            "X_X_X())"
    form2 = "MATCH('EOD t-1'!R2C1:R" & rows & "C1&'EOD t-1'!R2C2:R" & rows & "C2&'EOD t-1'!R2C3:R" & rows & "C3,'EOD t-1'!R2C1:R" & rows & "C1&'EOD t-1'!R2C2:R" & rows & "C2&'EOD t-1'!R2C3:R" & rows & "C3,0))),"
    form3 = "ROW('EOD t-1'!R2C1:R" & rows & "C1)-ROW('EOD t-1'!R2C1)+1),'EOD t-1'!R2C8:R" & rows & "C8)),RC[-3]/(RC[-2]/100))"
    
    With ActiveSheet.Range("H2:H" & rows1 & "")
        .FormulaArray = form1
        .Replace "X_X())", form2
        .Replace "X_X_X())", form3
        .NumberFormat = "_($* #,##0_);_($* (#,##0);_($* ""-""??_);_(@_)"
    End With

**shg** · 12-19-2013, 02:01 PM

I'm not a SendKeys advocate, but I use it to insert long array formulas. Here's the sub and an example of usage:

Sub demo()
  Const sFrm   As String = _
     "=IF(AND(RC[-12]:RC[-1]=""""),""No RoB assessments performed""," & vbLf & _
     "IF(OR(CHOOSE({1,2,3,4,5},RC[-10],RC[-8],RC[-6],RC[-4],RC[-2])=""no""),""HIGH""," & vbLf & _
     "IF(OR(CHOOSE({1,2,3,4,5},RC[-10],RC[-8],RC[-6],RC[-4],RC[-2])=""High Risk""),""HIGH""," & vbLf & _
     "IF(OR(CHOOSE({1,2,3,4,5},RC[-10],RC8],RC[-6],RC[-4],RC[-2])=""UNCLEAR""),""UNCLEAR""," & vbLf & _
     "IF(OR(CHOOSE({1,2,3,4,5},RC[-10],RC[-8],RC[-6],RC[-4],RC[-2])=""Unclear Risk""),""UNCLEAR"",""LOW"")))))"

  Debug.Print InsertArrayFormula(Range("M1"), sFrm)
End Sub

Function InsertArrayFormula(r As Range, _
              sFrm As String, _
              iRef As XlReferenceStyle, _
              Optional ByVal sFmt As String = "") As Boolean
  ' shg 2009, 2012

  ' Inserts the A1 or R1C1 array formula sFrm into r
  ' The VBE CANNOT have focus when this runs!

  Dim iRefSav   As XlReferenceStyle   ' current ref style
  Dim rSel    As Range        ' current selection

  If r.Worksheet.ProtectContents Then Exit Function
    
  Set rSel = ActiveWindow.RangeSelection
  
  With Application
    iRefSav = .ReferenceStyle
    .ReferenceStyle = iRef
    
    On Error GoTo Oops
    .ScreenUpdating = False

    With r.Areas(1)
      ' Can't put an array formula in cells that are
      ' not either all locked or all unlocked, so ...
      .Locked = .Cells(1).Locked

      ' Cache the number format, set to text, insert formula, restore format
      If Len(sFmt) = 0 Then sFmt = .NumberFormat
      .NumberFormat = "@"
      .Value = sFrm
      .NumberFormat = sFmt

      Application.Goto .Cells
    End With

    DoEvents
    .SendKeys "{F2}^+~"
    DoEvents
    .Goto rSel
    InsertArrayFormula = True

Outtahere:
    .ReferenceStyle = iRefSav
    .ScreenUpdating = True
    Exit Function
  End With

Oops:
  Resume Outtahere
End Function

**shg** · 12-19-2013, 02:05 PM

BTW, you might build the whole formula as a string and see if it's correct. Your first Replace is going to replace two instances, and the second will replace none.

**Kaper** · 12-19-2013, 02:11 PM

I dont think it will do all the work, but notice that after

.Replace "X_X())", form2

you have no single occurence of "X_X_X())" because all that used to look like that after first repalce look

X_MATCH('EOD t-1'!R2C1:R" & rows & "C1&'EOD t-1'!R2C2:R" & rows & "C2&'EOD t-1'!R2C3:R" & rows & "C3,'EOD t-1'!R2C1:R" & rows & "C1&'EOD t-1'!R2C2:R" & rows & "C2&'EOD t-1'!R2C3:R" & rows & "C3,0))),

so first try to

.Replace "X_X_X())", form3
.Replace "X_X())", form2

Next: I'd personally work other way - first prepare valid formula as a string and only after having valid formula ready, assign it to a cell. (may be it is worth reconsidering and reconstruct formula, or use some extra region to make partial calculations and make main formula shorter).

**jiver1** · 12-19-2013, 07:49 PM

I ended up doing the following to get the long array entered, but when I went to copy and past the array down the column, I had to enter the copy and paste code into another sub. It works as long as I call them separately, but if I try to put them both in one sub or call one sub with the other, it copies down the exact formula without updating the row numbers and the cell that was copied is no longer an array. Any thoughts as to why this might be?

Sub Array ()
  Range("H2").Select
    Selection.FormulaR1C1 = "=IF(R[0]C[-2]=0,SUM(IF(FREQUENCY(IF('EOD t-1'!R2C1:R80C1=EOD!RC[-7],IF('EOD t-1'!R2C3:R80C3=RC[-5],MATCH('EOD t-1'!R2C1:R80C1&'EOD t-1'!R2C2:R80C2&'EOD t-1'!R2C3:R80C3,'EOD t-1'!R2C1:R80C1&'EOD t-1'!R2C2:R80C2&'EOD t-1'!R2C3:R80C3,0))),ROW('EOD t-1'!R2C1:R80C1)-ROW('EOD t-1'!R2C1)+1),'EOD t-1'!R2C8:R80C8)),EOD!RC[-3]/(EOD!RC[-2]/100))"
    Range("H2").Select
    SendKeys "{F2}^+~"

End Sub

Sub MATH()

Dim EODrows As Long

EODrows = Range("G3").End(xlDown).Row

Range("H3").Select

Range("H2").Select
Selection.Copy
Range("H3:H" & EODrows).Select
ActiveSheet.Paste

Application.CutCopyMode = False

End Sub

**shg** · 12-20-2013, 01:18 AM

''''^''''1

**jiver1** · 12-20-2013, 02:23 PM

shg, I ended up using a lot of the code that you proposed and it worked in one instance, below:

Function InsertArrayFormula(r As Range, totalrisk As String)

Dim rSel As Range

Set rSel = ActiveWindow.RangeSelection

With Application

    With r.Areas(1)
        .Value = totalrisk
    Application.Goto .Cells
    End With
    
    DoEvents
    .SendKeys "{F2}^+~"
    DoEvents
    .Goto rSel
    InsertArrayFormula = True

End With

End Function

Sub EOD_Total()
   
   Const totalrisk As String = "=IF(SUM(IF(FREQUENCY(IF(EOD!R2C1:R80C1='EOD Summary'!RC[-2]," & vbLf & _
        "IF(EOD!R2C3:R80C3=""F"",MATCH(EOD!R2C1:R80C1&EOD!R2C2:R80C2&EOD!R2C3:R80C3,EOD!R2C1:R80C1&EOD!R2C2:" & vbLf & _
        "R80C2&EOD!R2C3:R80C3,0))),ROW(EOD!R2C1:R80C1)-ROW(EOD!R2C1)+1),EOD!R2C8:R80C8))=0," & vbLf & _
        "SUM(IF(FREQUENCY(IF('EOD t-1'!R2C1:R80C1='EOD Summary'!RC[-2],IF('EOD t-1'!R2C3:R80C3=""F""," & vbLf & _
        "MATCH('EOD t-1'!R2C1:R80C1&'EOD t-1'!R2C2:R80C2&'EOD t-1'!R2C3:R80C3,'EOD t-1'!R2C1:R80C1&" & vbLf & _
        "'EOD t-1'!R2C2:R80C2&'EOD t-1'!R2C3:R80C3,0))),ROW('EOD t-1'!R2C1:R80C1)-ROW('EOD t-1'!R2C1)+1)," & vbLf & _
        "'EOD t-1'!R2C8:R80C8))+RC[-1],SUM(IF(FREQUENCY(IF(EOD!R2C1:R80C1='EOD Summary'!RC[-2]," & vbLf & _
        "IF(EOD!R2C3:R80C3=""F"",MATCH(EOD!R2C1:R80C1&EOD!R2C2:R80C2&EOD!R2C3:R80C3,EOD!R2C1:R80C1&" & vbLf & _
        "EOD!R2C2:R80C2&EOD!R2C3:R80C3,0))),ROW(EOD!R2C1:R80C1)-ROW(EOD!R2C1)+1),EOD!R2C8:R80C8))+RC[-1])"
    
    Debug.Print InsertArrayFormula(Range("C2"), totalrisk)
        
End Sub

However, when I tried the same thing with another formula, I receive a run time 1004 error message regarding the new constant, custrisk. I really appreciate all of the help so far and any insight here, would be a big help.

Thanks.

Function InsertArrayFormula(r As Range, custrisk As String)

Dim rSel As Range

Set rSel = ActiveWindow.RangeSelection

With Application

    With r.Areas(1)
        .Value = custrisk
    Application.Goto .Cells
    End With
    
    DoEvents
    .SendKeys "{F2}^+~"
    DoEvents
    .Goto rSel
    InsertArrayFormula = True

End With

End Function

Sub EOD_Customer()
  
   Const custrisk As String = "=IF(SUM(IF(FREQUENCY(IF(EOD!R2C1:R80C1='EOD Summary'!RC[-1]," & vbLf & _
        "IF(EOD!R2C3:R80C3=""C"",MATCH(EOD!R2C1:R80C1&EOD!R2C2:R80C2&EOD!R2C3:R80C3," & vbLf & _
        "EOD!R2C1:R80C1&EOD!R2C2:R80C2&EOD!R2C3:R80C3,0))),ROW(EOD!R2C1:R80C1)-ROW(EOD!R2C1)+1)," & vbLf & _
        "EOD!R2C8:R80C8))+SUM(IF(FREQUENCY(IF(EOD!R2C1:R80C1='EOD Summary'!RC[-1],IF(EOD!R2C3:R80C3=""M""," & vbLf & _
        "MATCH(EOD!R2C1:R80C1&EOD!R2C2:R80C2&EOD!R2C3:R80C3,EOD!R2C1:R80C1&EOD!R2C2:R80C2&EOD!R2C3:R80C3," & vbLf & _
        "0))),ROW(EOD!R2C1:R80C1)-ROW(EOD!R2C1)+1),EOD!R2C8:R80C8))=0,SUM(IF(FREQUENCY(IF('EOD t-1'!R2C1:" & vbLf & _
        "R80C1='EOD Summary'!RC[-1],IF('EOD t-1'!R2C3:R80C3=""C"",MATCH('EOD t-1'!R2C1:R80C1&" & vbLf & _
        "'EOD t-1'!R2C2:R80C2&'EOD t-1'!R2C3:R80C3,'EOD t-1'!R2C1:R80C1&'EOD t-1'!R2C2:R80C2&" & vbLf & _
        "'EOD t-1'!R2C3:R80C3,0))),ROW('EOD t-1'!R2C1:R80C1)-ROW('EOD t-1'!R2C1)+1),EOD t-1'!R2C8:R80C8))" & vbLf & _
        "+SUM(IF(FREQUENCY(IF('EOD t-1'!R2C1:R80C1='EOD Summary'!RC[-1],IF('EOD t-1'!R2C3:R80C3=""M""," & vbLf & _
        "MATCH('EOD t-1'!R2C1:R80C1&'EOD t-1'!R2C2:R80C2&'EOD t-1'!R2C3:R80C3," & vbLf & _
        "'EOD t-1'!R2C1:R80C1&'EOD t-1'!R2C2:R80C2&'EOD t-1'!R2C3:R80C3,0))),ROW('EOD t-1'!R2C1:R80C1)-" & vbLf & _
        "ROW('EOD t-1'!R2C1)+1),'EOD t-1'!R2C8:R80C8)),SUM(IF(FREQUENCY(IF(EOD!R2C1:R80C1=" & vbLf & _
        "'EOD Summary'!RC[-1],IF(EOD!R2C3:R80C3=""C"",MATCH(EOD!R2C1:R80C1&EOD!R2C2:R80C2&EOD!R2C3:R80C3," & vbLf & _
        "EOD!R2C1:R80C1&EOD!R2C2:R80C2&EOD!R2C3:R80C3,0))),ROW(EOD!R2C1:R80C1)-ROW(EOD!R2C1)+1)," & vbLf & _
        "EOD!R2C8:R80C8))+SUM(IF(FREQUENCY(IF(EOD!R2C1:R80C1='EOD Summary'!RC[-1],IF(EOD!R2C3:R80C3=""M""," & vbLf & _
        "MATCH(EOD!R2C1:R80C1&EOD!R2C2:R80C2&EOD!R2C3:R80C3,EOD!R2C1:R80C1&EOD!R2C2:R80C2&" & vbLf & _
        "EOD!R2C3:R80C3,0))),ROW(EOD!R2C1:R80C1)-ROW(EOD!R2C1)+1),EOD!R2C8:R80C8)))"
    
    Debug.Print InsertArrayFormula(Range("B2"), custrisk)

End Sub

**jiver1** · 12-20-2013, 10:21 AM

shg--I tried using the code you recommended, but to be honest, I did not understand a lot of what it was doing and could not get it to work in the way that it looks like it was intended which was to enter the array you defined as a constant into cell M1.

Thanks.

**shg** · 12-20-2013, 02:30 PM

Post the workbook?

**jiver1** · 12-20-2013, 02:55 PM

I updated the insertarrayforumla function to incorporate everything you had in yours and it returns an error--argument not optional, so it seems to be looking for inputs to the other two portions of the function, the xlReferenceStyle and the Optional ByVal. I actually tried guessing some inputs for these and it crashed excel, so I am updating the function again. It seems reasonable that it is looking for the other two arguments, how does it work for you without the last two?

Thanks again.

**shg** · 12-20-2013, 03:11 PM

Sorry, this line

Debug.Print InsertArrayFormula(Range("M1"), sFrm)

should be

Debug.Print InsertArrayFormula(Range("M1"), sFrm, xlR1C1)

The last argument specifies the reference style of the formula.

With that change, it worked fine.

Long Array Formulas Using VBA

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

Long Array Formulas Using VBA

Re: Long Array Formulas Using VBA

Re: Long Array Formulas Using VBA

Re: Long Array Formulas Using VBA

Re: Long Array Formulas Using VBA

Re: Long Array Formulas Using VBA

Re: Long Array Formulas Using VBA

Re: Long Array Formulas Using VBA

Re: Long Array Formulas Using VBA

Re: Long Array Formulas Using VBA

Re: Long Array Formulas Using VBA

Thread Information

Users Browsing this Thread

Similar Threads

Array Formulas taking too long to calculate

How can one populate a long array?

Long Array Formula VBA

Codes to long Possible Array may help ?

Array Formulas take waaaay too long...

Bookmarks

Bookmarks

Posting Permissions