VBA Help - Using Join Function to build dynamic Sum Formula - Excel 2016

[Johnny Thunder]

Hello All,


I am working on a project and head a road block with some code, there is a super manual way to do this but I know that this can be done with some form of Join code I am just not that familiar with the best way to approach this.

Here is my problem:

I have a loop that runs down row by row on my lookups sheet for some categories, when a non-blank cell is found, the code offsets two columns over to find a numeric variable which is a count for how many codes the formula will need to process which is defined by the string cCount which can be 1 - 10. Directly below that row I do the same defining of a variable gCount
which can also have the numeric value 1 -10.

an example of what I am doing with the variables below

Scenario 1#
cCount = 0
gCount = 1

Formula result should look like this: .FormulaR1C1 = "=SUMPRODUCT((GData = " & gItem.Value & ") *(IOHeader=RC4)* (Hdata = R7C) * DataTable)/1000"

In the example above, cCount was 0 which is why there is no variable for cItem included and only a gItem variable within the formula
*cItem and gItem are the values one column over from the respective Count variables.

Scenario 2#
cCount = 1
gCount = 1

Formula result should look like this: .FormulaR1C1 = "=SUMPRODUCT((GData = " & gItem.Value & ")*(cData = " & cItem.Value & ") *(IOHeader=RC4)* (Hdata = R7C) * DataTable)/1000"

In the example above, cCount was 1 and gCount was 1 which is why both are included in the formula

Scenario 3# Where things start getting more complex
cCount = 2
gCount = 1

Formula result should look like this: FormulaR1C1 = "=SUMPRODUCT((GData = " & gItem.Value & ") *(IOHeader=RC4)*(CData = " & cItem.Value & ") * (Hdata = R7C) * DataTable)/1000+SUMPRODUCT((GData = " & gItem.Offset(0, 1).Value & ") *(IOHeader=RC4)*(CData = " & cItem.Offset(0, 1).Value & ") * (Hdata = R7C) * DataTable)/1000"

In this example, cCount was 2 which requires that the formula be written 2 times to include both the original cItem value as well as the next value in the adjacent cell, gCount would be repeated in both formulas, in the event that gCount was 2 as well then the formula would need to be written to account for all variations of the cItem and gItem variations.

This scenario could be played out up to 10 values for each cItem and gItem.

So, I am able to achieve the lookups of each scenario using a case statement. I am just applying some math and adding both cCount and gCount together, and processing them that way, the problem that I face is having to write out the formula x amount of times based on the various possibilities of count.

Any direction would be great. Thanks in advance.



FYI - I was able to think of a better way of doing this but I hit a wall with that approach hence this above method.
So using the macro recorder I went to my matrix where cItem and gItem are found and copied each variable and went to my Report data and filtered the contents by each of the variables appending each variable to the filter until all values were met then just summed up the $Amounts and pasted that into the cells where my formulas would have gone. This was fast and easy problem was when I attempted to modify the recorder code and do this dynamically with variables instead of manually selecting everything the code wouldn't work.

My brain is fried at this point.... LOL

 

[pgc01]

Hi

I just tried to insert a similar formula and I spotted the error, excel does not like the space between Sumproduct and the open parenthesis.

"Sumproduct (" does not work"
"Sumproduct(" works

Remove that space and try.

 

[Johnny Thunder]

Woohoo! Ok, so that was the problem with the formulas. After removing the space the formulas are coming thru perfectly.

So after looking at all the available values in the matrix I did notice one small issue and I am hoping you have an idea on how to get around it.

So, here is your code embedded within my code, you will see how I am identifying cItem and gItem is based on a loop/offset, there is a variable within my matrix that is "All" so essentially, don't use that field as part of the lookup so that it just brings in all the values from that parameter.

Example: If cItem = 2970 and gItem= "All" .

The formula should look like this =IFERROR(SUMPRODUCT((Cdata = 2972) * (IOHeader = $D10) * (Hdata = I$7) * DataTable) / 1000,0) as you can see gItem wasn't included in the formula since it was defined as "All"

Currently looks like this =IFERROR(SUMPRODUCT((GData = All) * (IOHeader = $D10) * (Cdata = 2972) * (Hdata = I$7) * DataTable) / 1000,0)

So, just don't include the criteria if the C or g Item is "All"

Any ideas on how to do this? Its the final piece of the puzzle.

Thanks again for all the help!

Here is the modified code -

Sub CreateFormulas()


Dim ws1          As Worksheet, ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet, ws5 As Worksheet
Dim rNg           As Range, cell As Range, FoundR As Range
Dim cCount     As Long, gCount As Long, Class As String, cItem As Range, gItem As Range, Period As String, cItem2 As String, gItem2 As String
Dim lastR        As Long, y As Long, x As Long
Dim DoMath    As Variant


Dim vArr As Variant, v As Variant
Dim sF As String, sF1 As String, sF2 As String


Set ws1 = Sheets("Sum of Ops") 'Sum Of ops 2
Set ws2 = Sheets("Lookups")
Set ws3 = Sheets("Staging")
Set ws4 = Sheets("Actuals Export")
Set ws5 = Sheets("Forecast Export")


sF1 = "IFERROR(SumProduct(#g# *  #c # * (IOHeader = RC4) * (Hdata = R7C) * DataTable) / 1000,0)"


Set rNg = ws1.Range("C9:C56") 'Loop on Sum of Ops Sheet ------Need to include Lastr code


            For x = 6 To 9
            
            For Each cell In rNg
                If cell <> vbNullString Then    'Will only fire if Cell has data
                    
                         Class = cell.Value 'Name of Grouping
                         
                         sF = vbNullString 'Clears SumProduct for next loop
                     
                                With ws2.Range("C:C") 'Reference to Lookups
                                       Set FoundR = .Find(What:=Class, After:=.Cells(.Cells.Count), LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
                                       
                                              cCount = FoundR.Offset(1, 1) 'Defines How many combinations of Cost Centers are needed
                                       gCount = FoundR.Offset(2, 1) 'Defines how many combinations of G/L Accounts are needed
                            End With
                     
                     DoMath = cCount + gCount 'Determines if the CC & GL combo have values, if not, skip
    
                Set cItem = FoundR.Offset(1, 3) 'Defines How many combinations of Cost Centers are needed
                Set gItem = FoundR.Offset(2, 3) 'Defines how many combinations of G/L Accounts are needed
                
    If DoMath <> 0 Then
                vArr = GetPermutations(cCount, gCount)
                
        For Each v In vArr
                sF2 = sF1
                        If v(0) = 0 Then sF2 = Replace(sF2, "#c  # *", "") Else sF2 = Replace(sF2, "#c  #", "(CData = " & cItem.Offset(0, v(0) - 1).Value & ")")
                        If v(1) = 0 Then sF2 = Replace(sF2, "#g# *", "") Else sF2 = Replace(sF2, "#g#", "(GData = " & gItem.Offset(0, v(1) - 1).Value & ")")
                    sF = sF & "+" & sF2
            Next v
        sF = "=" & Mid(sF, 2)


cell.Offset(0, x).FormulaR1C1 = sF


     Else 'If Do Math
     End If
             
     Else  'If Ccount+GCount
     
    End If   'If Ccount+GCount
     
        Next cell    '1st For Each Code
    
    Next x 'Loop to next column (I:L)


End Sub
' generates the permutations given cCoutn and gCount
Function GetPermutations(cCount As Long, gCount As Long) As Variant


Dim i As Long, j As Long, k As Long
Dim vArr As Variant


ReDim vArr(1 To IIf(cCount = 0, 1, cCount) * IIf(gCount = 0, 1, gCount))


For j = IIf(cCount = 0, 0, 1) To cCount
    For k = IIf(gCount = 0, 0, 1) To gCount
        i = i + 1
        vArr(i) = VBA.Array(j, k)
    Next k
Next j


GetPermutations = vArr


End Function

 

[Johnny Thunder]

I think I just figured it out!!!!!! Not sure if this is the best way to go about modifying the code from my post above but here is what I came up with the tackle the "All" comment,

'--------------------------------------------------------------------------
'--- Loop to create formulas on Sum of Ops Sheet 1 of 2
'--------------------------------------------------------------------------
Sub CreateFormulas()


Dim ws1          As Worksheet, ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet, ws5 As Worksheet
Dim rNg           As Range, cell As Range, FoundR As Range
Dim cCount     As Long, gCount As Long, Class As String, cItem As Range, gItem As Range, Period As String, cItem2 As String, gItem2 As String
Dim lastR        As Long, y As Long, x As Long
Dim DoMath    As Variant


Dim vArr As Variant, v As Variant
Dim sF As String, sF1 As String, sF2 As String


Set ws1 = Sheets("Sum of Ops") 'Sum Of ops 2
Set ws2 = Sheets("Lookups")
Set ws3 = Sheets("Staging")
Set ws4 = Sheets("Actuals Export")
Set ws5 = Sheets("Forecast Export")


'sF1 = "IFERROR(SumProduct(#g # *  #c  # * (IOHeader = RC4) * (Hdata = R7C) * DataTable) / 1000,0)"


Set rNg = ws1.Range("C9:C56") 'Loop on Sum of Ops Sheet ------Need to include Lastr code


            For x = 6 To 9
            
            For Each cell In rNg
                If cell <> vbNullString Then    'Will only fire if Cell has data
                    
                         Class = cell.Value 'Name of Grouping
                         
                         sF = vbNullString 'Clears SumProduct for next loop
                         sF1 = vbNullString
                     
                                With ws2.Range("C:C") 'Reference to Lookups
                                       Set FoundR = .Find(What:=Class, After:=.Cells(.Cells.Count), LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
                                       
                                              cCount = FoundR.Offset(1, 1) 'Defines How many combinations of Cost Centers are needed
                                       gCount = FoundR.Offset(2, 1) 'Defines how many combinations of G/L Accounts are needed
                            End With
                     
                     DoMath = cCount + gCount 'Determines if the CC & GL combo have values, if not, skip
    
                Set cItem = FoundR.Offset(1, 3) 'Defines How many combinations of Cost Centers are needed
                Set gItem = FoundR.Offset(2, 3) 'Defines how many combinations of G/L Accounts are needed
                
               Select Case True
                        Case cItem = "All"
                             sF1 = "IFERROR(SumProduct(#g # * (IOHeader = RC4) * (Hdata = R7C) * DataTable) / 1000,0)"
                         Case gItem = "All"
                             sF1 = "IFERROR(SumProduct(#c  # * (IOHeader = RC4) * (Hdata = R7C) * DataTable) / 1000,0)"
                        Case cItem <> "All" Or gItem <> "All"
                             sF1 = "IFERROR(SumProduct(#g # *  #c  # * (IOHeader = RC4) * (Hdata = R7C) * DataTable) / 1000,0)"
                End Select


    If DoMath <> 0 Then
                vArr = GetPermutations(cCount, gCount)
                
        For Each v In vArr
                sF2 = sF1
                        If v(0) = 0 Then sF2 = Replace(sF2, "#c  # *", "") Else sF2 = Replace(sF2, "#c  #", "(CData = " & cItem.Offset(0, v(0) - 1).Value & ")")
                        If v(1) = 0 Then sF2 = Replace(sF2, "#g # *", "") Else sF2 = Replace(sF2, "#g #", "(GData = " & gItem.Offset(0, v(1) - 1).Value & ")")
                    sF = sF & "+" & sF2
            Next v
        sF = "=" & Mid(sF, 2)


cell.Offset(0, x).FormulaR1C1 = sF


     Else 'If Do Math
     End If
             
     Else  'If Ccount+GCount
     
    End If   'If Ccount+GCount
     
        Next cell    '1st For Each Code
    
    Next x 'Loop to next column (I:L)


End Sub
'--------------------------------------------------------------------------
'--- Generates variations of the cItem/gItem formula 2 of 2
'--------------------------------------------------------------------------
Function GetPermutations(cCount As Long, gCount As Long) As Variant


Dim i As Long, j As Long, k As Long
Dim vArr As Variant


ReDim vArr(1 To IIf(cCount = 0, 1, cCount) * IIf(gCount = 0, 1, gCount))


For j = IIf(cCount = 0, 0, 1) To cCount
    For k = IIf(gCount = 0, 0, 1) To gCount
        i = i + 1
        vArr(i) = VBA.Array(j, k)
    Next k
Next j


GetPermutations = vArr


End Function

 

[pgc01]

It seems to do the job.

I was thinking that another way would be to set cCount to zero in case of cItem="All".

Anyway I'm glad you figured it out!

 

[Johnny Thunder]

Thanks again for all the help on this.

 

[Johnny Thunder]

Hey @pgc01 I got another project that uses the same matrix of values off to the right of the summary cells and tried to use the code you provided with a little modification but was unable to get the code to work.

This project isn't as complicated since there is only 1 criteria for GL Account instead of 2 like in the last project (GL Account/Cost Center). This may be why the code is not working. I modified several of the lines to account for only one variable but unfortunetely I don't know enough about how the loop you sent me works so I may be close and just need a little nudge with what I have.

I feel like I am close, the code is doing everything I need it to do, just need the permutation piece and this is all done. Any help is appreciated.

Here is where I am at....

Option Explicit
'--------------------------------------------------------------------------
'--- Created formulas based on user selection of periods
'--------------------------------------------------------------------------
Sub EnterFormula()


Dim ws              As Worksheet, ws2 As Worksheet
Dim FindCol1    As Range, FindCol2 As Range, cell As Range
Dim Fd              As String, fd2 As String
Dim PriorR       As String, CurrR As String
Dim LastR       As Long, LastR2 As Long
Dim vArr        As Variant, v As Variant, gCount As Variant
Dim sF          As String, sF1 As String, sF2 As String


Set ws = Sheets("Cover Sheet Summary BS") 'BS Summary
Set ws2 = Sheets("Drop in BW Raw Data") 'Raw data


LastR = ws2.Range("A" & Rows.Count).End(xlUp).Row 'Finds last row with data


PriorR = ws.Range("B3").Value
CurrR = ws.Range("B6").Value


'On Error GoTo Help


    With ws2 'The below Searches and indentifies the Columns that have the period names
        Set FindCol1 = .Range("41:41").Find(What:=PriorR, LookIn:=xlValues)
        Set FindCol2 = .Range("41:41").Find(What:=CurrR, LookIn:=xlValues)
        
         'Converts the column number to a letter
        Fd = Chr(FindCol1.Column + 64) 'Prior
        fd2 = Chr(FindCol2.Column + 64) 'Current
    End With
    
'---------------------------------------------Named Ranges Update-----------------------------------------------
'Updates to named ranges - Defines GL Account
With ActiveWorkbook.Names("gItem")
        .Name = "gItem"
           .RefersTo = "='Drop In BW Raw Data'!$C$42:$C$" & LastR & ""
             Application.ScreenUpdating = False
                 Application.DisplayAlerts = False
        End With


'Updates to named ranges - Defines Prior Period Values
With ActiveWorkbook.Names("pItem")
        .Name = "pItem"
        .RefersTo = "='Drop In BW Raw Data'!$" & Fd & "$42:$" & Fd & "$" & LastR & ""
             Application.ScreenUpdating = False
                 Application.DisplayAlerts = False
        End With


'Updates to named ranges - Defines Current Period Values
With ActiveWorkbook.Names("cItem")
        .Name = "cItem"
           .RefersTo = "='Drop In BW Raw Data'!$" & fd2 & "$42:$" & fd2 & "$" & LastR & ""
             Application.ScreenUpdating = False
                 Application.DisplayAlerts = False
        End With
'---------------------------------------------Named Ranges Update-----------------------------------------------


    For Each cell In ws.Range("P12:P28") 'Loops down my summary sheet and populates formulas if row has a value
        If cell <> vbNullString Or cell <> 0 Then
        gCount = cell.Value
                'gCount = Application.WorksheetFunction.CountA(Range(cell.Address & ":" & cell.Offset(0, 19).Address)) 'Not being used
        
        sF1 = "=SUMIF(gitem," & "#g # *" & ",citem)/1000"  'Can either be the cell reference or the value in the cell


         vArr = GetPermutations((gCount))


       For Each v In vArr
                sF2 = sF1
                        If v = 0 Or v = vbNullString Then sF2 = Replace(sF2, "#g # *", "") Else sF2 = Replace(sF2, "#g #", cell.Offset(0, v(1) - 1).Value & ")")
                    sF = sF & "+" & sF2
            Next v
                    sF = "=" & Mid(sF, 2)
                    cell.Offset(0, 9).Formla = sF  'Where the results need to be pasted
                       End If
            Next cell


End Sub
'--------------------------------------------------------------------------
'--- Generates variations of the cItem/gItem formula 2 of 2
'--------------------------------------------------------------------------
Function GetPermutations(gCount As Long) As Variant


Dim i As Long, k As Long
Dim vArr As Variant


ReDim vArr(1 To IIf(gCount = 0, 1, gCount))


    For k = IIf(gCount = 0, 0, 1) To gCount
        i = i + 1
        vArr(i) = VBA.Array(k)
    Next k


GetPermutations = vArr


End Function