Sumproduct to Table...

[DonkeyOte]

Does anyone know of a utility / function or have themselves coded something that permits an end user to analyse a given Sumproduct formula in greater detail - ie returning the results of the generated array into tabular form ?

I've just sat down thinking this would be quite useful, ie I click on any sumproduct formula and run a routine to "Analyse" which in turn generates a new sheet with a matrix of the results...

However having just started coding this myself it is now dawning on me that this could prove very difficult (read beyond my abilities) ... breaking out the formula itself etc into component parts is pretty easy but actually evaluating each part is a little more difficult.

I suspect someone knows of an elegant way to do this and I'd love to see it... it may of course be that you can do this already but I don't know how...

Thanks,
Luke

 

[RoryA]

Early start - been tweaking code all night?

 

[DonkeyOte]

Emma, update below -- added in some bits and pieces for handling different delimiters (via Application.InputBox) and also put in an error handler for when the routine fails to evaluate a component correctly.

This is working for me on every single SUMPRODUCT I try it against that's showing up here on the forum... when you use the * approach you will get Boolean returns obviously (which in some cases is nice).

I particularly like it when there is an underlying error in source data as this approach let's you find it quickly if you have large dataset.

Option Explicit
Sub Analyse_SumProduct_DONKEYOTE()
'-------------------------------------------------------------------------------------------------------------------------
'coded (poorly) by DonkeyOte Weds 22 Oct 2008
'tough bits coded by messrs. rorya, RichardSchollar & CornflakeGirl (aka Rory, Richard & Emma)
'abbreviations
'SP - SumProduct
'SPA - SumProduct Analysis
'-------------------------------------------------------------------------------------------------------------------------
'#DEFINE VARIABLES (Assign/Set where possible)
'-------------------------------------------------------------------------------------------------------------------------
Dim r_c1 As Range: Set r_c1 = ActiveCell
Dim s_s1 As String: s_s1 = ActiveSheet.Name                 'to hold sheet name on which SP formula resides
Dim s_s2 As String                                          'to hold sheet name of SPA sheet (to be created)
Dim s_c1 As String: s_c1 = ActiveCell.Address(0, 0)         'to hold cell address in which SP formula resides
Dim s_c1_f As String: s_c1_f = ActiveCell.formula           'to hold SP formula being analysed
Dim s_c1_f_res As Long                                      'to hold result of SP formula being analysed
Dim i_c1_f_i As Long                                        'to hold mid char point when iterating formula string
Dim i_c1_f_p_cnt As Long                                    'to hold running total of parentheses
Dim i_c1_f_start As Long                                    'to hold start char pos of SP component
Dim s_c1_f_delim As String                                  'to hold SP component delimiter (eg "," or "*") set via InputBox
Dim i_c1_f_c As Integer                                     'to hold count of "components" within SP formula
Dim l_c1_f_comp_i As Long                                   'incremental column flag of component parts
Dim s_c1_f_comp As String                                   'component part of formula as stored in row 5 on SPA sheet
Dim v_c1_f_output                                           'used to store result of component part
Dim e As Long                                               'used to hold possible cause of error on initial evaulation
'-------------------------------------------------------------------------------------------------------------------------
'#SET APP SETTINGS
'-------------------------------------------------------------------------------------------------------------------------
With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With
'-------------------------------------------------------------------------------------------------------------------------
'#STEP 1: VALIDATE FORMULA BEING ANALYSED -- EXIT IF INAPPROPRIATE FOR THIS ROUTINE
'-------------------------------------------------------------------------------------------------------------------------
On Error Resume Next
s_c1_f_res = Evaluate(s_c1_f)
On Error GoTo 0
If InStr(UCase(s_c1_f), "=SUMPRODUCT") = 0 Then e = 1       'although formula is valid it's not a SUMPRODUCT formula!
If InStr(s_s1, "SPA") Then e = 1                            'firing code from previously created SPA sheet!
'exit routine if formula not valid for analysis
If e <> 0 Then
    MsgBox "Current Formula Not Valid for SUMPRODUCT Analysis"
    GoTo ExitHere:
End If
'-------------------------------------------------------------------------------------------------------------------------
'#STEP 1a: DETERMINE DELIMITER (let user decide...)
'-------------------------------------------------------------------------------------------------------------------------
s_c1_f_delim = Application.InputBox("Enter Delimiter" & vbCrLf & "Note: Normally one of , * ;", "Delimiter", ",", Type:=2)
Select Case s_c1_f_delim
    Case ",", "*", ";"
    Case Else
        MsgBox s_c1_f_delim & "Not Valid for SUMPRODUCT Analysis"
        GoTo ExitHere:
End Select
'-------------------------------------------------------------------------------------------------------------------------
'#STEP 2: INSERT A NEW SHEET ON WHICH THE SPA WILL BE HELD
'set name convention to utilise system time so as to remove possibility of duplication without need for ws testing / deletion
'set up headers
'-------------------------------------------------------------------------------------------------------------------------
Sheets.Add
ActiveSheet.Name = "SPA_" & Format(Now(), "DDMMYY_HHMMSS")
s_s2 = ActiveSheet.Name
Cells(1, 1) = "Formula Location:"
Cells(1, 2) = s_s1 & "!" & s_c1
Cells(2, 1) = "Formula: "
Cells(2, 2) = "'" & s_c1_f
Cells(3, 1) = "Result: "
Cells(3, 2) = s_c1_f_res
Cells(5, 1) = "Component Part(s):"
Cells(7, 1) = "Row/Column:"
Cells(7, 2) = "Result:"
'-------------------------------------------------------------------------------------------------------------------------
'#STEP 3: BEGINNING STRIPPING DOWN FORMULA INTO "COMPONENT" PARTS
'first remove =SUMPRODUCT() leaving just innards behind...
'loop the remaining string using predefined component "delimiter" (eg "," or "*") to break into parts (check parentheses)
'-------------------------------------------------------------------------------------------------------------------------
s_c1_f = Replace(s_c1_f, "=SUMPRODUCT(", "")
s_c1_f = Left(s_c1_f, Len(s_c1_f) - 1)
'default start pos of string to be 1
i_c1_f_start = 1
'iterate formula string
For i_c1_f_i = i_c1_f_start To Len(s_c1_f) Step 1
    'ascertain current character and act appropriately
    Select Case Mid(s_c1_f, i_c1_f_i, 1)
        Case "("
            'opening parentheses so add 1 to parentheses count
            i_c1_f_p_cnt = i_c1_f_p_cnt + 1
        Case ")"
            'closing parentheses so remove 1 from parentheses count
            i_c1_f_p_cnt = i_c1_f_p_cnt - 1
        Case s_c1_f_delim
            'current char appears to be delimiter however only valid end point IF count of parentheses is 0
            If i_c1_f_p_cnt = 0 Then
                'increment count of components
                i_c1_f_c = i_c1_f_c + 1
                'paste formula component as header in column B onwards (row 5)
                Cells(5, 1 + i_c1_f_c) = Chr(34) & Mid(s_c1_f, i_c1_f_start, i_c1_f_i - i_c1_f_start) & Chr(34)
                'reset start pos to be current string pos + 1
                i_c1_f_start = i_c1_f_i + 1
            End If
    End Select
Next i_c1_f_i
'insert final component
'increment count of components
i_c1_f_c = i_c1_f_c + 1
'paste formula component as header in column B onwards (row 5)
Cells(5, 1 + i_c1_f_c) = Chr(34) & Mid(s_c1_f, i_c1_f_start, i_c1_f_i - 1) & Chr(34)
'-------------------------------------------------------------------------------------------------------------------------
'#STEP 4: EVALUATE EACH COMPONENT PART & WRITE BACK RESULTS TO SPA SHEET (add total column)
'-------------------------------------------------------------------------------------------------------------------------
For l_c1_f_comp_i = 2 To Sheets(s_s2).Cells(5, Columns.Count).End(xlToLeft).Column Step 1
    s_c1_f_comp = Sheets(s_s2).Cells(5, l_c1_f_comp_i)
    s_c1_f_comp = "IF(ROW(1:1)," & Mid(Left(s_c1_f_comp, Len(s_c1_f_comp) - 1), 2) & ")"
    v_c1_f_output = r_c1.Parent.Evaluate(s_c1_f_comp)
    On Error GoTo Fatality:
    Sheets(s_s2).Cells(8, l_c1_f_comp_i).Resize(UBound(v_c1_f_output)).Value = v_c1_f_output
Next l_c1_f_comp_i
Sheets(s_s2).Select
Cells(5, Columns.Count).End(xlToLeft).Offset(2, 1).Value = "Total(s)"
Cells(8, l_c1_f_comp_i).Resize(UBound(v_c1_f_output)).FormulaR1C1 = "=IF(COUNT(RC2:RC[-1])<>COLUMNS(C2:C[-1]),0,PRODUCT(RC2:RC[-1]))"
Cells(8, l_c1_f_comp_i).Resize(UBound(v_c1_f_output)).formula = Cells(8, l_c1_f_comp_i).Resize(UBound(v_c1_f_output)).Value
Cells(8, l_c1_f_comp_i).Resize(UBound(v_c1_f_output)).Font.Bold = True
'-------------------------------------------------------------------------------------------------------------------------
'#STEP 5: FORMAT SPA SHEET
'-------------------------------------------------------------------------------------------------------------------------
Columns(1).AutoFit
Range(Cells(5, 2), Cells(5, 2).End(xlToRight)).Columns.AutoFit
'-------------------------------------------------------------------------------------------------------------------------
'#EXIT POINT
'-------------------------------------------------------------------------------------------------------------------------
ExitHere:
'-------------------------------------------------------------------------------------------------------------------------
'#RESET APP SETTINGS
'-------------------------------------------------------------------------------------------------------------------------
With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With
'-------------------------------------------------------------------------------------------------------------------------
'#END
'-------------------------------------------------------------------------------------------------------------------------
Exit Sub

Fatality:
MsgBox "Fatal Error Occurred Processing Component Part", vbCritical, "Fatal Error"
Resume ExitHere:

End Sub

EDIT: Sorry Rory didn't see your post... no ... wife's rule "if one of has to get up we both get up" ... needless to say this rule only applies under certain conditions (ie she's up first).

 

[RoryA]

Yeah, it's funny how annoyed mine gets if I wake her up at 5.30..

 

[cornflakegirl]

Emma, not quite sure I follow... at present no formulas are shown on the result SumProduct Analysis sheet as the formulas are usurped by their values.

Sorry - Rory had the PRODUCT formulas in his result sheet, so I must have assumed that you had them too. As you were! Nice use of usurped though

(Can I just point out that, flattered and honoured though I am to be cited in your code at all, I am in fact a girl.)

 

[DonkeyOte]

I have come across one interesting problem though... if you use * as delimiter and thus get booleans return to the SPA sheet the resulting PRODUCT formula will for some reason see FALSE as 1 (it's stored as a boolean and not text)

So assume you had returned matrix of (B:C)

TRUE, 2
FALSE, 3
TRUE, 1

You would expect to get results of (D)

2
0
1

But using PRODUCT(B:C) you get

2
3
1

Why is this ?

Obviously SUMPRODUCT(--B,C) will return

2
0
1

Confused.Com

EDIT: This is no doubt some elementary thing I'm missing right... re: your point concerning credit - noted.
Other point -- I am aware that I missing an On Error GoTo 0 after the Evaluation... this has been rectified... am now working on fixing the above.

 

[Richard Schollar]

That's very interesting. Text is apparently ignored too (if it looks like text and not a number). But not errors (they propagate as usual).

It's a funny old world

 

[cornflakegirl]

Luke - how hard would it be to have both , and * as delimiters? Just been doing a quick search of the board and there are quite a lot of examples of people using both.

 

[DonkeyOte]

Strange indeed...

Work around, replacement of:

Cells(8, l_c1_f_comp_i).Resize(UBound(v_c1_f_output)).FormulaR1C1 = "=IF(COUNT(RC2:RC[-1])<>COLUMNS(C2:C[-1]),0,PRODUCT(RC2:RC[-1]))

with

Cells(8, l_c1_f_comp_i).Resize(UBound(v_c1_f_output)).FormulaR1C1 = "=IF(OR(SUMPRODUCT(--(ISNUMBER(--(RC2:RC[-1]))=FALSE)),COUNTIF(RC2:RC[-1],FALSE)),0,PRODUCT(RC2:RC[-1]))"

 

[Richard Schollar]

You run into big complications with more complicated formulas that may incorporate * within terms rather than between them in Sumproduct.

EDIT: altho I would have thought that would apply to commas too. I haven't gone over Luke's code (or Rory's) so I don't know if or how it accounts for these situations.

 

[cornflakegirl]

Richard - Luke has done v clever things with counting parentheses - if the parenthesis count is zero, it's a delimiter!