Replacing multiple values in a string in an Array Formula in VBA

[l7ete]

I have the below formula which works in excel:

{=IF(SUM(O3:Q3)=0,"no",IF(AND(INDEX(Direction_check!D:D,MATCH(1,(Direction_check!A:A=$O3)*(Direction_check!B:B=$P3),0))-INDEX(Direction_check!H:H,MATCH(1,(Direction_check!E:E=$B3)*(Direction_check!F:F=$C3),0))<=4,INDEX(Direction_check!D:D,MATCH(1,(Direction_check!A:A=$O3)*(Direction_check!B:B=$P3),0))-INDEX(Direction_check!H:H,MATCH(1,(Direction_check!E:E=$B3)*(Direction_check!F:F=$C3),0))>=-4),"no","yes"))}

The problem is when I translate this into VBA, as below, the string exceeds the maximum characters for an array formula.

Selection.FormulaArray = _
"=IF(SUM(RC[-3]:RC[-1])=0,""no"",IF(AND(INDEX(Direction_check!C[-14],MATCH(1,(Direction_check!C[-17]=RC15)*(Direction_check!C[-16]=RC16),0))-INDEX(Direction_check!C[-10],MATCH(1,(Direction_check!C[-13]=RC2)*(Direction_check!C[-12]=RC3),0))<=4,INDEX(Direction_check!C[-14],MATCH(1,(Direction_check!C[-17]=RC15)*(Direction_check!C[-16]=RC16),0))-INDEX(Direction_check!C[-" & _
"10],MATCH(1,(Direction_check!C[-13]=RC2)*(Direction_check!C[-12]=RC3),0))>=-4),""no"",""yes""))" & _
""

As a work around I've tried to split the formula into parts, as below:

Sub Macro1()

Dim FormulaPart1 As String

Dim FormulaPart2a As String

Dim FormulaPart2b As String

Dim FormulaPart2c As String

Dim FormulaPart2d As String


FormulaPart2a = "INDEX(Direction_check!C[-14],MATCH(1,(Direction_check!C[-17]=RC15)*(Direction_check!C[-16]=RC16),0))"

FormulaPart2b = "INDEX(Direction_check!C[-10],MATCH(1,(Direction_check!C[-13]=RC2)*(Direction_check!C[-12]=RC3),0))"

FormulaPart2c = "INDEX(Direction_check!C[-14],MATCH(1,(Direction_check!C[-17]=RC15)*(Direction_check!C[-16]=RC16),0))"

FormulaPart2d = "INDEX(Direction_check!C[-" & "10],MATCH(1,(Direction_check!C[-13]=RC2)*(Direction_check!C[-12]=RC3),0))"

FormulaPart1 = "=IF(SUM(RC[-3]:RC[-1])=0,""no"",IF(AND(""X1""-""X2""<=4,""X3""-""X4"">=-4),""no"",""yes""))"


With ActiveSheet.Range("V3")

Dim Originals As Variant

Dim Replacements As Variant

Dim i As Long

Originals = Array("""X1""", """X2""", """X3""", """X4""")

Replacements = Array(FormulaPart2a, FormulaPart2b, FormulaPart2c, FormulaPart2d)

For i = 0 To 3

.FormulaArray = Replace(FormulaPart1, Originals(i), Replacements(i))

Next

End With

End Sub

This works however it only replaces "X4" in the cell, as each time it loops it starts with FormulaPart1 again. Is there anyway to get it to replace all four "X's" in one step? The trouble is if it isn't completed in one step then the length of the array formula exceeds the maximum number of characters and returns an error.

Any help would be great!

Peter

 

[JustynaMK]

Maybe something like that?

Sub Macro1()
    Dim FormulaPart1        As String
    Dim FormulaPart2a       As String
    Dim FormulaPart2b       As String
    Dim FormulaPart2c       As String
    Dim FormulaPart2d       As String
    Dim Originals           As Variant
    Dim Replacements        As Variant
    Dim i                   As Long

    FormulaPart2a = "INDEX(Direction_check!C[-14],MATCH(1,(Direction_check!C[-17]=RC15)*(Direction_check!C[-16]=RC16),0))"
    FormulaPart2b = "INDEX(Direction_check!C[-10],MATCH(1,(Direction_check!C[-13]=RC2)*(Direction_check!C[-12]=RC3),0))"
    FormulaPart2c = "INDEX(Direction_check!C[-14],MATCH(1,(Direction_check!C[-17]=RC15)*(Direction_check!C[-16]=RC16),0))"
    FormulaPart2d = "INDEX(Direction_check!C[-" & "10],MATCH(1,(Direction_check!C[-13]=RC2)*(Direction_check!C[-12]=RC3),0))"
    FormulaPart1 = "IF(SUM(RC[-3]:RC[-1])=0,""no"",IF(AND(""X1""-""X2""<=4,""X3""-""X4"">=-4),""no"",""yes""))"
    
    Originals = Array("""X1""", """X2""", """X3""", """X4""")
    Replacements = Array(FormulaPart2a, FormulaPart2b, FormulaPart2c, FormulaPart2d)
    
    Range("V3").Value = FormulaPart1
    
    With Range("V3")
        For i = 0 To 3
            .Value = Replace(.Value, Originals(i), Replacements(i))
        Next i
    End With
    
    Range("V3").Value = "=" & Range("V3").Value

End Sub

 

[l7ete]

Maybe something like that?

Sub Macro1()
    Dim FormulaPart1        As String
    Dim FormulaPart2a       As String
    Dim FormulaPart2b       As String
    Dim FormulaPart2c       As String
    Dim FormulaPart2d       As String
    Dim Originals           As Variant
    Dim Replacements        As Variant
    Dim i                   As Long

    FormulaPart2a = "INDEX(Direction_check!C[-14],MATCH(1,(Direction_check!C[-17]=RC15)*(Direction_check!C[-16]=RC16),0))"
    FormulaPart2b = "INDEX(Direction_check!C[-10],MATCH(1,(Direction_check!C[-13]=RC2)*(Direction_check!C[-12]=RC3),0))"
    FormulaPart2c = "INDEX(Direction_check!C[-14],MATCH(1,(Direction_check!C[-17]=RC15)*(Direction_check!C[-16]=RC16),0))"
    FormulaPart2d = "INDEX(Direction_check!C[-" & "10],MATCH(1,(Direction_check!C[-13]=RC2)*(Direction_check!C[-12]=RC3),0))"
    FormulaPart1 = "IF(SUM(RC[-3]:RC[-1])=0,""no"",IF(AND(""X1""-""X2""<=4,""X3""-""X4"">=-4),""no"",""yes""))"
    
    Originals = Array("""X1""", """X2""", """X3""", """X4""")
    Replacements = Array(FormulaPart2a, FormulaPart2b, FormulaPart2c, FormulaPart2d)
    
    Range("V3").Value = FormulaPart1
    
    With Range("V3")
        For i = 0 To 3
            .Value = Replace(.Value, Originals(i), Replacements(i))
        Next i
    End With
    
    Range("V3").Value = "=" & Range("V3").Value

End Sub

As far as I can tell the problem with this solution is that the formula is no longer defined as an array formula.

If you edit your code so that .value is instead .FormulaArray then you seem get the old problem that the number of characters is too long, as by the time it tries to replace X2 the number of characters exceeds the limit.

 

[JustynaMK]

Sorry l7ete for a mistake. Please test the following version:

Sub Macro1()
    Dim FormulaPart1        As String
    Dim FormulaPart2a       As String
    Dim FormulaPart2b       As String
    Dim FormulaPart2c       As String
    Dim FormulaPart2d       As String
    Dim Originals           As Variant
    Dim Replacements        As Variant
    Dim i                   As Long

    FormulaPart2a = "INDEX(Direction_check!C[-14],MATCH(1,(Direction_check!C[-17]=RC15)*(Direction_check!C[-16]=RC16),0))"
    FormulaPart2b = "INDEX(Direction_check!C[-10],MATCH(1,(Direction_check!C[-13]=RC2)*(Direction_check!C[-12]=RC3),0))"
    FormulaPart2c = "INDEX(Direction_check!C[-14],MATCH(1,(Direction_check!C[-17]=RC15)*(Direction_check!C[-16]=RC16),0))"
    FormulaPart2d = "INDEX(Direction_check!C[-" & "10],MATCH(1,(Direction_check!C[-13]=RC2)*(Direction_check!C[-12]=RC3),0))"
    FormulaPart1 = "=IF(SUM(RC[-3]:RC[-1])=0,""no"",IF(AND(""X1""-""X2""<=4,""X3""-""X4"">=-4),""no"",""yes""))"
    
    Originals = Array("X1", "X2", "X3", "X4")
    Replacements = Array(FormulaPart2a, FormulaPart2b, FormulaPart2c, FormulaPart2d)
    
    Range("V3").FormulaArray = FormulaPart1
    
    With Range("V3")
        For i = 0 To 3
            .Replace Originals(i), Replacements(i)
        Next i
    End With

End Sub