F.Q.A.: FIND_FORMULA

The question:
"There are values (numbers) in the input range. I would like to find the formula of how the calculation of these values is done to get the asked result."

In response I created the user defined function:

FIND_FORMULA

returns the formula of how the calculation of values can be done.

Syntax
FIND_FORMULA(rValues, iResult, [sOperators], [rNames], [bHidePlus], [bFindForZero], [bShowBrackets])

Arguments:
rValues - required - the range of cells which FIND_FORMULA will try combine to find the result.
iResult - required - the value which should be the result of the found formula.
sOperators - optional - text string of the operators which FIND_FORMULA will try to use for finding the formula (e.g. "+-*/"). The default value is "+-".
rNames - optional - the range of cells which FIND_FORMULA will use as variable names. If this argument is omitted the addresses of the cells (rValues) will be used.
bFindForZero - optional - determines what FIND_FORMULA does if the result is equal to 0. If bHidePlus is true the function will try to find the formula. In opposite case the function will return zero-length string. The default value is false.
bShowBrackets - optional - if bShowBrackets is true FIND_FORMULA will add the round brackets at the start and at the end of the returned formula. The default value is true.
bHidePlus - optional - if bHidePlus is false and the result is positive number FIND_FORMULA will add "+" at the start of the returned formula. The default value is true.

Remarks:

• rValues must be a single-row and single-area range which must have two cells at least.
• iResult must be a whole number.
• rNames must be a single-row and single-area range which must have the same number of cells as rValues.

Examples:

	A	B	C	D	E	F	G	H	I	J
1	a	b	c	d	e	f	g	h	?	output
2	formula
3	5	12	9	6	5	11	15	20		#VALUE!
4	=FIND_FORMULA(A3:H3,0,,A1:D1)
5	2	11	7	9	8	15	8	19	a:h=25 (+-)	(A5+E5+F5)
6	=FIND_FORMULA(A5:H5,25)
7	14	15	7	15	11	16	16	8	a:h=-13 (+-)	-(a+b-f)
8	=FIND_FORMULA(A7:H7,-13,,A1:H1)
9	18	14	19	16	9	6	12	19	a:h=25 (+-)	(c+f)
10	=FIND_FORMULA(A9:H9,25,"",A1:H1)
11	11	6	15	11	18	17	14	6	a:h=66 (*/)	(A11*B11)
12	=FIND_FORMULA(A11:H11,66,"*/")
13	16	3	13	20	20	10	6	7	a:h=520 (*/)	+(C13*D13*E13/F13)
14	=FIND_FORMULA(A13:H13,520,"*/",,,,FALSE)
15	11	13	6	7	11	5	1	16	a:h=520 (*/)	#N/A
16	=FIND_FORMULA(A15:H15,520,"*/")
17	19	6	1	12	3	5	3	18	h+a:g=40 (+-)	h+(a+e)
18	=H1&FIND_FORMULA(A17:G17,40-H17,,A1:G1,,,FALSE)
19	20	8	4	19	20	6	2	18	a:f=12 (+-)	(a-b)
20	=FIND_FORMULA(A19:H19,12,,A1:H1)
21	20	8	4	19	20	6	2	18	a:f=12 (+)	(b+c)
22	=FIND_FORMULA(A21:H21,12,"+",A1:H1)
23	1	9	3	10	18	17	5	16	a:g=h (+-)	h=-(a-f)
24	=H1&"="&FIND_FORMULA(A23:G23,H23,,A1:G1,,FALSE,TRUE)
25	16	6	15	11	8	14	15	15	g-a:f=h (+-)	h=g
26	=H1&"="&G1&FIND_FORMULA(A25:F25,H25-G25,,A1:F1,,,FALSE)
27	16	6	15	11	8	14	15	15	g-a:f=h (+-)	h=g+(b+e-f)
28	=H1&"="&G1&FIND_FORMULA(A27:F27,H27-G27,,A1:F1,TRUE,,FALSE)
29	14	1	8	13	20	2	19	9	a:h=200 (+-*/)	(a*d+e-f)
30	=FIND_FORMULA(A29:H29,200,"+-*/",A1:H1)
31	9	7	1	9	3	12	18	1	a:h=-90 (+-*/)	-(a*f-g)
32	=FIND_FORMULA(A31:H31,-90,"+-*/",A1:H1,,FALSE)
33	6	20	7	13	3	5	9	6	a:h=-54 (+-*/)	-(a*g)
34	=FIND_FORMULA(A33:H33,-54,"+-*/",A1:H1)
35	12	17	13	20	16	10	3	1	a:h=-92 (+)	-(a+b+c+d+e+f+g+h)
36	=FIND_FORMULA(A35:H35,-92,"+",A1:H1,,FALSE)
37	-2	2	3	4	5	6	7	8	a:h=-37 (+-)	a-b-c-d-e-f-g-h
38	=FIND_FORMULA(A37:H37,-37,,A1:H1,,FALSE)

Download:
You can download the workbook with code and examples here

The code:

Select all

Function FIND_FORMULA(rValues As Range, iResult As Long, Optional sOperators As String = "+-", Optional rNames As Range = Nothing, Optional bFindForZero As Boolean = False, Optional bShowBrackets As Boolean = True, Optional bHidePlus As Boolean = True) As Variant
  Dim vRetValue As Variant
  
  If Not rValues.Rows.Count = 1 Or rValues.Columns.Count = 1 Then
    vRetValue = xlErrValue
  End If
  
  If Not TypeName(vRetValue) = "Long" Then
    If Len(sOperators) = 0 Then
      sOperators = "+-"
    End If
  End If
  
  If Not TypeName(vRetValue) = "Long" Then
    If Not rNames Is Nothing Then
      If Not rNames.Rows.Count = 1 Or rNames.Columns.Count = 1 Or Not rNames.Columns.Count = rValues.Columns.Count Then
        vRetValue = xlErrValue
      End If
    End If
  End If
  
  If Not TypeName(vRetValue) = "Long" Then
    Dim iRemainder As Integer
    iRemainder = iResult
    If iRemainder = 0 And Not bFindForZero Then
      vRetValue = vbNullString
    Else
      If Application.WorksheetFunction.CountIf(rValues, iRemainder) = 0 Then
        Dim iNumbers() As Integer
        ReDim iNumbers(1 To rValues.Columns.Count)
        Dim sStrings() As String
        ReDim sStrings(1 To rValues.Columns.Count)
        
        Dim i As Integer
        For i = 1 To UBound(iNumbers)
          iNumbers(i) = rValues.Cells(1, i).Value
          If rNames Is Nothing Then
            sStrings(i) = rValues.Cells(i).Address(RowAbsolute:=False, ColumnAbsolute:=False)
          Else
            sStrings(i) = rNames.Cells(i).Value
          End If
        Next i
        
        Dim vNumberCombinations() As Variant
        Dim sStringCombinations() As String
        ReDim vNumberCombinations(0)
        ReDim sStringCombinations(0)
        Dim vNumberComb() As Variant
        Dim sStringComb() As String
        For i = 2 To UBound(iNumbers)
          ReDim vNumberComb(1 To i)
          ReDim sStringComb(1 To i)
          Call subNumberCombinations(vNumberCombinations, sStringCombinations, vNumberComb, sStringComb, iNumbers, sStrings, i, 1, 1)
        Next i
        
        Dim bExists As Boolean
        Dim sNumberFormula As String, sStringFormula As String
        Dim sOperComp As String
        Dim iOperComp As Integer, iEle As Integer
        For i = 0 To UBound(vNumberCombinations)
          For iOperComp = 0 To Application.WorksheetFunction.Power(Len(sOperators), UBound(Split(vNumberCombinations(i), ","))) - 1
            sOperComp = fncGetOperators(sOperators, iOperComp, UBound(Split(vNumberCombinations(i), ",")))
            
            sNumberFormula = Split(vNumberCombinations(i), ",")(0)
            sStringFormula = Split(sStringCombinations(i), ",")(0)
            For iEle = 1 To UBound(Split(vNumberCombinations(i), ","))
              sNumberFormula = sNumberFormula & Mid(sOperComp, iEle, 1) & Split(vNumberCombinations(i), ",")(iEle)
              sStringFormula = sStringFormula & Mid(sOperComp, iEle, 1) & Split(sStringCombinations(i), ",")(iEle)
            Next iEle
            If Evaluate(sNumberFormula) = iRemainder Then
              vRetValue = vRetValue & IIf(bHidePlus, vbNullString, "+") & IIf(bShowBrackets, "(", vbNullString) & sStringFormula & IIf(bShowBrackets, ")", vbNullString)
              bExists = True
              Exit For
            ElseIf Evaluate(sNumberFormula) = -iRemainder Then
              bShowBrackets = True
              vRetValue = vRetValue & "-" & IIf(bShowBrackets, "(", vbNullString) & sStringFormula & IIf(bShowBrackets, ")", vbNullString)
              bExists = True
              Exit For
            End If
          Next iOperComp
          If bExists Then
            Exit For
          End If
        Next i
        If Not bExists Then
          vRetValue = xlErrNA
        End If
      Else
        With Application.WorksheetFunction
        If rNames Is Nothing Then
          vRetValue = vRetValue & rValues.Cells(.Match(iRemainder, rValues, 0)).Address(RowAbsolute:=False, ColumnAbsolute:=False)
        Else
          vRetValue = vRetValue & .Index(rNames, .Match(iRemainder, rValues, 0))
        End If
        End With 'Application.WorksheetFunction
      End If
    End If
  End If
  
  If TypeName(vRetValue) = "Long" Then
    FIND_FORMULA = CVErr(vRetValue)
  Else
    FIND_FORMULA = vRetValue
  End If
End Function
 
Private Sub subNumberCombinations(vNumberCombinations() As Variant, sStringCombinations() As String, vNumberComb() As Variant, sStringComb() As String, iNumbers() As Integer, sStrings() As String, iCount As Integer, iElement As Integer, iIndex As Integer)
  Dim i As Long
  For i = iElement To UBound(iNumbers)
    vNumberComb(iIndex) = iNumbers(i)
    sStringComb(iIndex) = sStrings(i)
    
    If iIndex = iCount Then
      If Not vNumberCombinations(0) = vbNullString Then
        ReDim Preserve vNumberCombinations(UBound(vNumberCombinations) + 1)
        ReDim Preserve sStringCombinations(UBound(sStringCombinations) + 1)
      End If
      vNumberCombinations(UBound(vNumberCombinations)) = Join(vNumberComb, ",")
      sStringCombinations(UBound(sStringCombinations)) = Join(sStringComb, ",")
    Else
      Call subNumberCombinations(vNumberCombinations, sStringCombinations, vNumberComb, sStringComb, iNumbers, sStrings, iCount, i + 1, iIndex + 1)
    End If
  Next i
End Sub

Private Function fncGetOperators(sOperators As String, iNumber As Integer, iLength As Byte) As String
  Dim sRetValue As String
  
  If Len(sOperators) > 1 Then
    Dim iRemainder As Integer
    iRemainder = iNumber
    sRetValue = vbNullString
    While Not iRemainder = 0
      sRetValue = Mid$(sOperators, iRemainder Mod Len(sOperators) + 1, 1) & sRetValue
      iRemainder = iRemainder \ Len(sOperators)
    Wend
  End If
  sRetValue = Replace(Space(iLength - Len(sRetValue)) & sRetValue, " ", Left$(sOperators, 1))
  
  fncGetOperators = sRetValue
End Function

Tweet