Checking for Proper Entry of Array Formulas

Hi, i tried last option :
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Right(Selection.FormulaArray, 5) = "(""{"")" Then
ActiveCell.Select
Selection.FormulaArray = ActiveCell.Formula
End If
End Sub

It works only partially, meaning it does make the formula back to array ONLY after i click on each cell containg this.

Is any option to make it work instantly(without having to click on each cell?

How nice... I see that the website has squished out all of the spaces it thought were redundant in my macro.

Well, if you know VBA, you can add the leading spaces back in to make it look nice.

If not, the code won't look pretty, but it should still work.

Personally, you just described the very reasons I hate array formulas:
1) They are easy to break.
2) Finding a broken array formula can be difficult.

Instead, I really prefer using the SUMPRODUCT() function. Others like using SUMIFS().

That said, I may receive workbooks from others with broken array formulas with a request to fix them. This is the macro I built to help me.


Sub ShowArrayFormulas()

' Show the array formulas entered on the active sheet
' These are cells with formulas entered using Ctrl-Shift-Enter

' Select the cells containing array formulas
' In addition, offer an option to pattern the cells with purple dots
' The purpose is to aid debugging

' Macro created 2011-01-14 by Dave Bonin


Dim Count As Long
Dim ThisCell As Range
Dim Where As String
Dim ErrorText As String
Dim MsgStatus As Long

' Handle errors gracefully
On Error GoTo ErrorHandler1

ErrorText = vbNullString
MsgStatus = vbInformation
Count = 0
Where = ""
For Each ThisCell In ActiveSheet.UsedRange
If ThisCell.HasArray = True Then
Count = Count + 1
Where = Where & ThisCell.Address & ","
End If
Next

If Count > 0 Then
Where = Left(Where, Len(Where) - 1)
Where = Replace(Where, "$", "")
Where = Replace(Where, "$", "") 'Repeated because this function has limits
On Error GoTo ErrorHandler2
ActiveSheet.Range(Where).Select
On Error GoTo ErrorHandler1
End If

If Count > 1 Then
If ErrorText = vbNullString Then
If MsgBox("There are " & Format(Count, "#,##0") & " cells containing" & vbCr & _
"array formulas on this sheet." & vbCr & vbCr & _
"Hit 'Ok' to pattern the cells." & ErrorText, _
vbOKCancel + MsgStatus, "Show Array Formulas") = vbOK Then
Selection.Interior.Pattern = xlGray16
Selection.Interior.PatternColorIndex = 47
End If
Else
MsgBox "There are " & Format(Count, "#,##0") & " cells containing" & vbCr & _
"array formulas on this sheet." & ErrorText, _
vbOK + MsgStatus, "Show Array Formulas"
End If

ElseIf Count = 1 Then
If ErrorText = vbNullString Then
If MsgBox("Just one cell on this sheet" & vbCr & _
"contains an array formula." & vbCr & vbCr & _
"It may be lonely. Go see." & vbCr & vbCr & _
"Hit 'Ok' to pattern the cells." & ErrorText, _
vbOKCancel + MsgStatus, "Show Array Formulas") = vbOK Then
Selection.Interior.Pattern = xlGray16
Selection.Interior.PatternColorIndex = 47
End If
Else
MsgBox "Just one cell on this sheet" & vbCr & _
"contains an array formula." & vbCr & vbCr & _
"It may be lonely. Go see." & ErrorText, _
vbOKOnly + MsgStatus, "Show Array Formulas"
End If
Else
MsgBox "No cells on this sheet" & vbCr & _
"contain an array formula." & ErrorText, _
vbOKOnly + MsgStatus, "Show Array Formulas"
End If

Exit Sub

ErrorHandler1:
ErrorText = vbCr & vbCr & "An error occurred:" & vbCr & Err.Description & "."
MsgStatus = vbExclamation
Resume Next

ErrorHandler2:
ErrorText = vbCr & vbCr & "Could not select or pattern the array cells."
MsgStatus = vbExclamation
Resume Next

End Sub