Lightest formula for sumifs with multiple criteria

cgsierra

Board Regular
Joined
Mar 21, 2011
Messages
142
Office Version
  1. 365
Hello,
I have a database set up in "Dbase" tab as follows:
Column A labeled LE, Column B labelled GTM, C labeled LOC, D labeled DEP, E labeled Amount. Each of these columns have over 20 different possible values. IE. LE (over 20 different possible values found in the database, ie 3,7,9,12,24,72,65,...), GTM (over 20 different possible values, ie 000,003,007,006,010,019,001,...), LOC (over 20 different possible values, ie 0101,0102,1245,2452,1110,0099,4215,...), DEP (over 20 different possible values, ie 1254,7845,0011,1289,6411,0001,4582,...)

I then have a second tab called "Output" set up as follows:
B3 = LE
B4 = GTM
B5 = LOC
B6 = DEP

range C3:F3 is used to type the multiple criteria used to look in Column A (LE) in the Dbase tab (4 or less possible criteria allowed, 1 in each column, ie C3=7, D3=12)

range C4:F4 is used to type the multiple criteria used to look in Column B (GTM) in the Dbase tab (4 or less possible criteria allowed, 1 in each column, ie C4=000, D4=019, E4=010, F4=003)

range C5:F5 is used to type the multiple criteria used to look in Column C (LOC) in the Dbase tab (4 or less possible criteria allowed, 1 in each column, ie C5=0101, D5=0102, E5=0099)

range C6:F6 is used to type the multiple criteria used to look in Column D (DEP) in the Dbase tab (4 or less possible criteria allowed, 1 in each column, ie C6=7845, D6=6411, E6=4582, F6=1289)

Once I enter the multiple criteria in the ranges mentioned above, the formula in cell b12 in tab "Output" should add column E (amount) for all the data in the Raw Data tab that fits the multiple criteria stated above.

I am looking for the lightest possible formula to execute this as the formula in b12 will be dragged over for about 500 rows and across 100 columns for a single sheet. The file itself may have about 10 of those Output sheets.

Please help!
 
Last edited:
I had already played around with writing a macro that creates the totals. And if I read your latest posts correctly, it pretty much does what you request there too. I based it on your screen prints, which was difficult. Next time consider using one of the screen printing tools, like the HTML Maker in my signature, to post a sample of your spreadsheet. It's MUCH easier to work on a problem when you can copy the data from the post and paste it to a test workbook. Most of the time people will not bother typing in all that data, so you don't get as many people trying to answer your question. Another option is to save your workbook to a file sharing service like Dropbox and post a link, but some people still can't or won't open files from the internet.

But back to the topic at hand. Try this: Open a COPY of your workbook. Press Alt-F11 to open the VBA editor. From the menu select Insert > Module. Paste the following code into the window that opens:

Rich (BB code):
Sub AddEmUp()
Dim MyTable As Range, MyAccts As Range, MyDates As Range, MyParms As Range, MyParmCols As Variant
Dim MyData As Variant, MyParmData As Variant, MyFilter As Object
Dim i As Long, j As Long, k As Long, d1 As String, acct As Variant, acc As Long, mdate As Variant


' Define parameters
    Set MyTable = Sheets("Raw Data").Range("A1:M1")             ' Define top row of the data table, the macro figures -
                                                                '  out the bottom row based on the last non-empty cell in A
    Set MyAccts = Sheets("Sheet2").Range("G35:G37")             ' This should be the column where the accounts are -
                                                                '  set the rows to first row with an account to the -
                                                                '  last row with an account, empty cells will be ignored
    Set MyDates = Sheets("Sheet2").Range("K11:M11, O11:Q11")    ' Set this to the cells with the dates, if there are gaps, -
                                                                '  define the ranges as shown.  The "ACTUALS" or "BUDGET" -
                                                                '  row is assumed to be above this row
    Set MyParms = Sheets("Sheet2").Range("J2:M8")               ' The parameters - can be an actual parameter or a "*" to mean -
                                                                '  match anything - no other wildcards are supported
    MyParmCols = Array(1, 2, 3, 0, 4, 5, 6)                     ' The columns that the parameters relate to - in this example, -
                                                                '  the parameters on row 2 match column 1 (A) on the "Raw Data" -
                                                                '  sheet, row 3 matches column 2, row 4 matches column 3, row 5 -
                                                                '  matches nothing (0), etc.
    
' Read the "Raw Data"
    MyData = MyTable.Resize(MyTable.Resize(1, 1).Offset(Rows.Count - 1).End(xlUp).Row).Value
' Read the parms
    MyParmData = MyParms.Value
' Create a dictionary to put the totals in
    Set MyFilter = CreateObject("Scripting.Dictionary")
    
' Read through the raw data, selecting the rows that match the parameters
    For i = 1 To UBound(MyData)
    
            For j = 1 To MyParms.Rows.Count
                If MyParmCols(j - 1) = 0 Then GoTo NextJ:
                For k = 1 To 4
                    If MyData(i, MyParmCols(j - 1)) = MyParms(j, k) Or MyParms(j, k) = "*" Then GoTo NextJ:
                Next k
                GoTo NextI:
NextJ:
            Next j
' Found a match on all parameters, create a key with the acct, month, year, and type,then add up the total
            d1 = CLng(MyData(i, 7)) & "|" & MyData(i, 9) & "|" & MyData(i, 10) & "|" & LCase(MyData(i, 12))
            MyFilter(d1) = MyFilter(d1) + MyData(i, 11)
            
NextI:
    Next i
    
' All totals found, now read through all the accounts/dates on the output sheet and place the totals
    Application.ScreenUpdating = False
    For Each acct In MyAccts
        acc = acct.Value
        If acc <> 0 Then                ' ignore empty cells in the Accounts column
            For Each mdate In MyDates
' Make a key with the account, month, year, and type, and read the total from the dictionary
                d1 = CLng(acct) & "|" & Month(mdate) & "|" & Year(mdate) & "|" & LCase(CStr(mdate.Offset(-1)))
                Cells(acct.Row, mdate.Column) = MyFilter(d1)
            Next mdate
        End If
    Next acct
    Application.ScreenUpdating = True
    
End Sub
Change the values in red to match your sheet. Return to your workbook. Select the output page (Sheet2). Press Alt-F8 for the macro selector, choose AddEmUp and click run.

This should run pretty fast. No formulas to slow down your sheet. No mucking around with Xs to select the columns you want, just change the ranges in the macro. Let me know what you think.

Thank you so very much Eric for your help. I think this will be perfect, the only thing additional is that I noticed that my accounts are defined separate from all other parameters as they change by row in the output area. How does the macro know what column from the raw data to use to match the accounts? I'm asking because I may have to add two extra columns next to the account column that will help me define the accounts better using 2 columns from the raw data.
 
Upvote 0

Excel Facts

Repeat Last Command
Pressing F4 adds dollar signs when editing a formula. When not editing, F4 repeats last command.
That's a good point. Most of the parameters are defined at the start, with MyParms and MyParmsCols. The account, month, year, and type are defined in 2 places in the macro.

First, when it first reads your Raw Data table, there's this line:

Code:
' Found a match on all parameters, create a key with the acct, month, year, and type,then add up the total
            d1 = CLng(MyData(i, [COLOR=#ff0000]7[/COLOR])) & "|" & MyData(i, [COLOR=#ff0000]9[/COLOR]) & "|" & MyData(i, [COLOR=#ff0000]10[/COLOR]) & "|" & LCase(MyData(i, [COLOR=#ff0000]12[/COLOR]))
The numbers in red are the columns where each of those parameters are found: 7=column G, 9=column I, etc.

Later in the macro we look at the combination of account/month/year/type by looking at the MyAccts and MyDates ranges:

Code:
' Make a key with the account, month, year, and type, and read the total from the dictionary
                d1 = CLng(acct) & "|" & Month(mdate) & "|" & Year(mdate) & "|" & LCase(CStr(mdate.Offset(-1)))

So if you add parts to the key, you'll need to change those 2 lines. The first line would change to something like:

Code:
' Found a match on all parameters, create a key with the acct, month, year, and type,then add up the total
            d1 = CLng(MyData(i, [COLOR=#FF0000]7[/COLOR])) & "|" & MyData(i, [COLOR=#FF0000]9[/COLOR]) & "|" & MyData(i, [COLOR=#FF0000]10[/COLOR]) & "|" & LCase(MyData(i, [COLOR=#FF0000]12[/COLOR])) & "|" & MyData(i, [COLOR=#ff0000]15[/COLOR]) & "|" & MyData(i, [COLOR=#ff0000]16[/COLOR])

and the second to something like:

Code:
' Make a key with the account, month, year, and type, and read the total from the dictionary
                d1 = CLng(acct) & "|" & Month(mdate) & "|" & Year(mdate) & "|" & LCase(CStr(mdate.Offset(-1))) & "|" & acc.offset(,1) & "|" & acc.offset(,2)

Those are just examples, it would depend on how you arrange your sheets.
 
Upvote 0
That's a good point. Most of the parameters are defined at the start, with MyParms and MyParmsCols. The account, month, year, and type are defined in 2 places in the macro.

First, when it first reads your Raw Data table, there's this line:

Code:
' Found a match on all parameters, create a key with the acct, month, year, and type,then add up the total
            d1 = CLng(MyData(i, [COLOR=#ff0000]7[/COLOR])) & "|" & MyData(i, [COLOR=#ff0000]9[/COLOR]) & "|" & MyData(i, [COLOR=#ff0000]10[/COLOR]) & "|" & LCase(MyData(i, [COLOR=#ff0000]12[/COLOR]))
The numbers in red are the columns where each of those parameters are found: 7=column G, 9=column I, etc.

Later in the macro we look at the combination of account/month/year/type by looking at the MyAccts and MyDates ranges:

Code:
' Make a key with the account, month, year, and type, and read the total from the dictionary
                d1 = CLng(acct) & "|" & Month(mdate) & "|" & Year(mdate) & "|" & LCase(CStr(mdate.Offset(-1)))

So if you add parts to the key, you'll need to change those 2 lines. The first line would change to something like:

Code:
' Found a match on all parameters, create a key with the acct, month, year, and type,then add up the total
            d1 = CLng(MyData(i, [COLOR=#FF0000]7[/COLOR])) & "|" & MyData(i, [COLOR=#FF0000]9[/COLOR]) & "|" & MyData(i, [COLOR=#FF0000]10[/COLOR]) & "|" & LCase(MyData(i, [COLOR=#FF0000]12[/COLOR])) & "|" & MyData(i, [COLOR=#ff0000]15[/COLOR]) & "|" & MyData(i, [COLOR=#ff0000]16[/COLOR])

and the second to something like:

Code:
' Make a key with the account, month, year, and type, and read the total from the dictionary
                d1 = CLng(acct) & "|" & Month(mdate) & "|" & Year(mdate) & "|" & LCase(CStr(mdate.Offset(-1))) & "|" & acc.offset(,1) & "|" & acc.offset(,2)

Those are just examples, it would depend on how you arrange your sheets.
Thank you Eric!
I will attempt this and let you know how it goes.
 
Upvote 0
That's a good point. Most of the parameters are defined at the start, with MyParms and MyParmsCols. The account, month, year, and type are defined in 2 places in the macro.

First, when it first reads your Raw Data table, there's this line:

Code:
' Found a match on all parameters, create a key with the acct, month, year, and type,then add up the total
            d1 = CLng(MyData(i, [COLOR=#ff0000]7[/COLOR])) & "|" & MyData(i, [COLOR=#ff0000]9[/COLOR]) & "|" & MyData(i, [COLOR=#ff0000]10[/COLOR]) & "|" & LCase(MyData(i, [COLOR=#ff0000]12[/COLOR]))
The numbers in red are the columns where each of those parameters are found: 7=column G, 9=column I, etc.

Later in the macro we look at the combination of account/month/year/type by looking at the MyAccts and MyDates ranges:

Code:
' Make a key with the account, month, year, and type, and read the total from the dictionary
                d1 = CLng(acct) & "|" & Month(mdate) & "|" & Year(mdate) & "|" & LCase(CStr(mdate.Offset(-1)))

So if you add parts to the key, you'll need to change those 2 lines. The first line would change to something like:

Code:
' Found a match on all parameters, create a key with the acct, month, year, and type,then add up the total
            d1 = CLng(MyData(i, [COLOR=#FF0000]7[/COLOR])) & "|" & MyData(i, [COLOR=#FF0000]9[/COLOR]) & "|" & MyData(i, [COLOR=#FF0000]10[/COLOR]) & "|" & LCase(MyData(i, [COLOR=#FF0000]12[/COLOR])) & "|" & MyData(i, [COLOR=#ff0000]15[/COLOR]) & "|" & MyData(i, [COLOR=#ff0000]16[/COLOR])

and the second to something like:

Code:
' Make a key with the account, month, year, and type, and read the total from the dictionary
                d1 = CLng(acct) & "|" & Month(mdate) & "|" & Year(mdate) & "|" & LCase(CStr(mdate.Offset(-1))) & "|" & acc.offset(,1) & "|" & acc.offset(,2)

Those are just examples, it would depend on how you arrange your sheets.

Hi Eric,
Thank you again for all your help! I’ve tested the code and had to do some adjustments for the change in data I mentioned earlier. However, I having problems executing.
I split it into 2 different modules. The first model only runs the code through row 333. This is because I need SL (L4:O4) to be part of the variables for the first section of the P&L but not for the second section (rows 334 and below). In order to accommodate column J in Sheet2 (“Code”) like Accounts are handled, in this first module I had to change the code from:
d1 = CLng(MyData(i, 7)) & "|" & MyData(i, 9) & "|" & MyData(i, 10) & "|" & LCase(MyData(i, 12)) & "|" & MyData(i, 15)
to
d1 = CLng(MyData(i, 7)) & "|" & MyData(i, 9) & "|" & MyData(i, 10) & "|" & LCase(MyData(i, 12)) & "|" & CLng(MyData(i, 13))
and
d1 = CLng(acct) & "|" & Month(mdate) & "|" & Year(mdate) & "|" & LCase(CStr(mdate.Offset(-1))) & "|" & acc.offset(, 1) & "|" & acc.offset(, 2)
to
d1 = CLng(acct) & "|" & Month(mdate) & "|" & Year(mdate) & "|" & LCase(CStr(mdate.Offset(-1))) & "|" & acct.offset(, 3)
Please note I had to type a “t” in acct.offset(, 3) in order to make it work…not sure if this is correct. However it did pull the numbers correctly. The problem is that it took over 5 minutes for the code to run. As this is a file used for forecasting purposes during crunch time I’m afraid we wouldn’t be able to use this solution. Is there a way to speed it up considerably (ie ~30 sec max)

The second module applies only to the bottom section of the P&L (starting row 334) and is the exact replica of the first module but attempts to ignore SL (L4:O4) as parameters as it is fixed in column I for value 145 (text format). Therefore SL in this module is treated like accounts and like column J “Code”
I’m having problems running this module. Not sure why. Would you be so kind as to look into the code?
I am attaching the files to
Module 1 code:
Sub AddEmUp()
Dim MyTable As Range, MyAccts As Range, MyDates As Range, MyParms As Range, MyParmCols As Variant
Dim MyData As Variant, MyParmData As Variant, MyFilter As Object
Dim i As Long, j As Long, k As Long, d1 As String, acct As Variant, acc As Long, mdate As Variant


' Define parameters
Set MyTable = Sheets("Raw Data").Range("A1:M1") ' Define top row of the data table, the macro figures -
' out the bottom row based on the last non-empty cell in A
Set MyAccts = Sheets("Sheet2").Range("G14:G333") ' This should be the column where the accounts are -
' set the rows to first row with an account to the -
' last row with an account, empty cells will be ignored
Set MyDates = Sheets("Sheet2").Range("M12:X12, AF12:AQ12, AY12:BJ12, BR12:CC12") ' Set this to the cells with the dates, if there are gaps, -
' define the ranges as shown. The "ACTUALS" or "BUDGET" -
' row is assumed to be above this row
Set MyParms = Sheets("Sheet2").Range("L2:O7") ' The parameters - can be an actual parameter or a "*" to mean -
' match anything - no other wildcards are supported
MyParmCols = Array(1, 2, 3, 4, 5, 6) ' The columns that the parameters relate to - in this example, -
' the parameters on row 2 match column 1 (A) on the "Raw Data" -
' sheet, row 3 matches column 2, row 4 matches column 3, row 5 -
' matches nothing (0), etc.

' Read the "Raw Data"
MyData = MyTable.Resize(MyTable.Resize(1, 1).Offset(Rows.Count - 1).End(xlUp).Row).Value
' Read the parms
MyParmData = MyParms.Value
' Create a dictionary to put the totals in
Set MyFilter = CreateObject("Scripting.Dictionary")

' Read through the raw data, selecting the rows that match the parameters
For i = 1 To UBound(MyData)

For j = 1 To MyParms.Rows.Count
If MyParmCols(j - 1) = 0 Then GoTo NextJ:
For k = 1 To 4
If MyData(i, MyParmCols(j - 1)) = MyParms(j, k) Or MyParms(j, k) = "*" Then GoTo NextJ:
Next k
GoTo NextI:
NextJ:
Next j
' Found a match on all parameters, create a key with the acct, month, year, and type,then add up the total
d1 = CLng(MyData(i, 7)) & "|" & MyData(i, 9) & "|" & MyData(i, 10) & "|" & LCase(MyData(i, 12)) & "|" & CLng(MyData(i, 13))
MyFilter(d1) = MyFilter(d1) + MyData(i, 11)

NextI:
Next i

' All totals found, now read through all the accounts/dates on the output sheet and place the totals
Application.ScreenUpdating = False
For Each acct In MyAccts
acc = acct.Value
If acc <> 0 Then ' ignore empty cells in the Accounts column
For Each mdate In MyDates
' Make a key with the account, month, year, and type, and read the total from the dictionary
d1 = CLng(acct) & "|" & Month(mdate) & "|" & Year(mdate) & "|" & LCase(CStr(mdate.Offset(-1))) & "|" & acct.Offset(, 3)
Cells(acct.Row, mdate.Column) = MyFilter(d1)
Next mdate
End If
Next acct
Application.ScreenUpdating = True

End Sub

Module 2 code:
Sub AddEmUp()
Dim MyTable As Range, MyAccts As Range, MyDates As Range, MyParms As Range, MyParmCols As Variant
Dim MyData As Variant, MyParmData As Variant, MyFilter As Object
Dim i As Long, j As Long, k As Long, d1 As String, acct As Variant, acc As Long, mdate As Variant


' Define parameters
Set MyTable = Sheets("Raw Data").Range("A1:M1") ' Define top row of the data table, the macro figures -
' out the bottom row based on the last non-empty cell in A
Set MyAccts = Sheets("Sheet2").Range("G336:G570") ' This should be the column where the accounts are -
' set the rows to first row with an account to the -
' last row with an account, empty cells will be ignored
Set MyDates = Sheets("Sheet2").Range("M12:X12, AF12:AQ12, AY12:BJ12, BR12:CC12") ' Set this to the cells with the dates, if there are gaps, -
' define the ranges as shown. The "ACTUALS" or "BUDGET" -
' row is assumed to be above this row
Set MyParms = Sheets("Sheet2").Range("L2:O7") ' The parameters - can be an actual parameter or a "*" to mean -
' match anything - no other wildcards are supported
MyParmCols = Array(1, 2, 0, 4, 5, 6) ' The columns that the parameters relate to - in this example, -
' the parameters on row 2 match column 1 (A) on the "Raw Data" -
' sheet, row 3 matches column 2, row 4 matches column 3, row 5 -
' matches nothing (0), etc.

' Read the "Raw Data"
MyData = MyTable.Resize(MyTable.Resize(1, 1).Offset(Rows.Count - 1).End(xlUp).Row).Value
' Read the parms
MyParmData = MyParms.Value
' Create a dictionary to put the totals in
Set MyFilter = CreateObject("Scripting.Dictionary")

' Read through the raw data, selecting the rows that match the parameters
For i = 1 To UBound(MyData)

For j = 1 To MyParms.Rows.Count
If MyParmCols(j - 1) = 0 Then GoTo NextJ:
For k = 1 To 4
If MyData(i, MyParmCols(j - 1)) = MyParms(j, k) Or MyParms(j, k) = "*" Then GoTo NextJ:
Next k
GoTo NextI:
NextJ:
Next j
' Found a match on all parameters, create a key with the acct, month, year, and type,then add up the total
d1 = CLng(MyData(i, 7)) & "|" & MyData(i, 9) & "|" & MyData(i, 10) & "|" & LCase(MyData(i, 12)) & "|" & CLng(MyData(i, 13)) & "|" & CLng(MyData(i, 3))
MyFilter(d1) = MyFilter(d1) + MyData(i, 11)

NextI:
Next i

' All totals found, now read through all the accounts/dates on the output sheet and place the totals
Application.ScreenUpdating = False
For Each acct In MyAccts
acc = acct.Value
If acc <> 0 Then ' ignore empty cells in the Accounts column
For Each mdate In MyDates
' Make a key with the account, month, year, and type, and read the total from the dictionary
d1 = CLng(acct) & "|" & Month(mdate) & "|" & Year(mdate) & "|" & LCase(CStr(mdate.Offset(-1))) & "|" & acct.Offset(, 3) & "|" & acct.Offset(, 2)
Cells(acct.Row, mdate.Column) = MyFilter(d1)
Next mdate
End If
Next acct
Application.ScreenUpdating = True

End Sub

Many thanks
https://www.dropbox.com/s/hi3wrsz861h1lwc/2018 NEW FORECAST MODEL v16c DB.xlsb?dl=0
 
Upvote 0
Hi Eric,
Thank you again for all your help! I’ve tested the code and had to do some adjustments for the change in data I mentioned earlier. However, I having problems executing.
I split it into 2 different modules. The first model only runs the code through row 333. This is because I need SL (L4:O4) to be part of the variables for the first section of the P&L but not for the second section (rows 334 and below). In order to accommodate column J in Sheet2 (“Code”) like Accounts are handled, in this first module I had to change the code from:
d1 = CLng(MyData(i, 7)) & "|" & MyData(i, 9) & "|" & MyData(i, 10) & "|" & LCase(MyData(i, 12)) & "|" & MyData(i, 15)
to
d1 = CLng(MyData(i, 7)) & "|" & MyData(i, 9) & "|" & MyData(i, 10) & "|" & LCase(MyData(i, 12)) & "|" & CLng(MyData(i, 13))
and
d1 = CLng(acct) & "|" & Month(mdate) & "|" & Year(mdate) & "|" & LCase(CStr(mdate.Offset(-1))) & "|" & acc.offset(, 1) & "|" & acc.offset(, 2)
to
d1 = CLng(acct) & "|" & Month(mdate) & "|" & Year(mdate) & "|" & LCase(CStr(mdate.Offset(-1))) & "|" & acct.offset(, 3)
Please note I had to type a “t” in acct.offset(, 3) in order to make it work…not sure if this is correct. However it did pull the numbers correctly. The problem is that it took over 5 minutes for the code to run. As this is a file used for forecasting purposes during crunch time I’m afraid we wouldn’t be able to use this solution. Is there a way to speed it up considerably (ie ~30 sec max)

The second module applies only to the bottom section of the P&L (starting row 334) and is the exact replica of the first module but attempts to ignore SL (L4:O4) as parameters as it is fixed in column I for value 145 (text format). Therefore SL in this module is treated like accounts and like column J “Code”
I’m having problems running this module. Not sure why. Would you be so kind as to look into the code?
I am attaching the files to
Module 1 code:
Sub AddEmUp()
Dim MyTable As Range, MyAccts As Range, MyDates As Range, MyParms As Range, MyParmCols As Variant
Dim MyData As Variant, MyParmData As Variant, MyFilter As Object
Dim i As Long, j As Long, k As Long, d1 As String, acct As Variant, acc As Long, mdate As Variant


' Define parameters
Set MyTable = Sheets("Raw Data").Range("A1:M1") ' Define top row of the data table, the macro figures -
' out the bottom row based on the last non-empty cell in A
Set MyAccts = Sheets("Sheet2").Range("G14:G333") ' This should be the column where the accounts are -
' set the rows to first row with an account to the -
' last row with an account, empty cells will be ignored
Set MyDates = Sheets("Sheet2").Range("M12:X12, AF12:AQ12, AY12:BJ12, BR12:CC12") ' Set this to the cells with the dates, if there are gaps, -
' define the ranges as shown. The "ACTUALS" or "BUDGET" -
' row is assumed to be above this row
Set MyParms = Sheets("Sheet2").Range("L2:O7") ' The parameters - can be an actual parameter or a "*" to mean -
' match anything - no other wildcards are supported
MyParmCols = Array(1, 2, 3, 4, 5, 6) ' The columns that the parameters relate to - in this example, -
' the parameters on row 2 match column 1 (A) on the "Raw Data" -
' sheet, row 3 matches column 2, row 4 matches column 3, row 5 -
' matches nothing (0), etc.

' Read the "Raw Data"
MyData = MyTable.Resize(MyTable.Resize(1, 1).Offset(Rows.Count - 1).End(xlUp).Row).Value
' Read the parms
MyParmData = MyParms.Value
' Create a dictionary to put the totals in
Set MyFilter = CreateObject("Scripting.Dictionary")

' Read through the raw data, selecting the rows that match the parameters
For i = 1 To UBound(MyData)

For j = 1 To MyParms.Rows.Count
If MyParmCols(j - 1) = 0 Then GoTo NextJ:
For k = 1 To 4
If MyData(i, MyParmCols(j - 1)) = MyParms(j, k) Or MyParms(j, k) = "*" Then GoTo NextJ:
Next k
GoTo NextI:
NextJ:
Next j
' Found a match on all parameters, create a key with the acct, month, year, and type,then add up the total
d1 = CLng(MyData(i, 7)) & "|" & MyData(i, 9) & "|" & MyData(i, 10) & "|" & LCase(MyData(i, 12)) & "|" & CLng(MyData(i, 13))
MyFilter(d1) = MyFilter(d1) + MyData(i, 11)

NextI:
Next i

' All totals found, now read through all the accounts/dates on the output sheet and place the totals
Application.ScreenUpdating = False
For Each acct In MyAccts
acc = acct.Value
If acc <> 0 Then ' ignore empty cells in the Accounts column
For Each mdate In MyDates
' Make a key with the account, month, year, and type, and read the total from the dictionary
d1 = CLng(acct) & "|" & Month(mdate) & "|" & Year(mdate) & "|" & LCase(CStr(mdate.Offset(-1))) & "|" & acct.Offset(, 3)
Cells(acct.Row, mdate.Column) = MyFilter(d1)
Next mdate
End If
Next acct
Application.ScreenUpdating = True

End Sub

Module 2 code:
Sub AddEmUp()
Dim MyTable As Range, MyAccts As Range, MyDates As Range, MyParms As Range, MyParmCols As Variant
Dim MyData As Variant, MyParmData As Variant, MyFilter As Object
Dim i As Long, j As Long, k As Long, d1 As String, acct As Variant, acc As Long, mdate As Variant


' Define parameters
Set MyTable = Sheets("Raw Data").Range("A1:M1") ' Define top row of the data table, the macro figures -
' out the bottom row based on the last non-empty cell in A
Set MyAccts = Sheets("Sheet2").Range("G336:G570") ' This should be the column where the accounts are -
' set the rows to first row with an account to the -
' last row with an account, empty cells will be ignored
Set MyDates = Sheets("Sheet2").Range("M12:X12, AF12:AQ12, AY12:BJ12, BR12:CC12") ' Set this to the cells with the dates, if there are gaps, -
' define the ranges as shown. The "ACTUALS" or "BUDGET" -
' row is assumed to be above this row
Set MyParms = Sheets("Sheet2").Range("L2:O7") ' The parameters - can be an actual parameter or a "*" to mean -
' match anything - no other wildcards are supported
MyParmCols = Array(1, 2, 0, 4, 5, 6) ' The columns that the parameters relate to - in this example, -
' the parameters on row 2 match column 1 (A) on the "Raw Data" -
' sheet, row 3 matches column 2, row 4 matches column 3, row 5 -
' matches nothing (0), etc.

' Read the "Raw Data"
MyData = MyTable.Resize(MyTable.Resize(1, 1).Offset(Rows.Count - 1).End(xlUp).Row).Value
' Read the parms
MyParmData = MyParms.Value
' Create a dictionary to put the totals in
Set MyFilter = CreateObject("Scripting.Dictionary")

' Read through the raw data, selecting the rows that match the parameters
For i = 1 To UBound(MyData)

For j = 1 To MyParms.Rows.Count
If MyParmCols(j - 1) = 0 Then GoTo NextJ:
For k = 1 To 4
If MyData(i, MyParmCols(j - 1)) = MyParms(j, k) Or MyParms(j, k) = "*" Then GoTo NextJ:
Next k
GoTo NextI:
NextJ:
Next j
' Found a match on all parameters, create a key with the acct, month, year, and type,then add up the total
d1 = CLng(MyData(i, 7)) & "|" & MyData(i, 9) & "|" & MyData(i, 10) & "|" & LCase(MyData(i, 12)) & "|" & CLng(MyData(i, 13)) & "|" & CLng(MyData(i, 3))
MyFilter(d1) = MyFilter(d1) + MyData(i, 11)

NextI:
Next i

' All totals found, now read through all the accounts/dates on the output sheet and place the totals
Application.ScreenUpdating = False
For Each acct In MyAccts
acc = acct.Value
If acc <> 0 Then ' ignore empty cells in the Accounts column
For Each mdate In MyDates
' Make a key with the account, month, year, and type, and read the total from the dictionary
d1 = CLng(acct) & "|" & Month(mdate) & "|" & Year(mdate) & "|" & LCase(CStr(mdate.Offset(-1))) & "|" & acct.Offset(, 3) & "|" & acct.Offset(, 2)
Cells(acct.Row, mdate.Column) = MyFilter(d1)
Next mdate
End If
Next acct
Application.ScreenUpdating = True

End Sub

Many thanks
https://www.dropbox.com/s/hi3wrsz861h1lwc/2018 NEW FORECAST MODEL v16c DB.xlsb?dl=0

xlsm version in case you run into any problems with dropbox and file type xlsb
https://www.dropbox.com/s/p8t9hn5eyo06eoj/2018%20NEW%20FORECAST%20MODEL%20v16c%20DB.xlsm?dl=0
 
Upvote 0
Upvote 0
I appreciate that you have a time crunch, however, please also understand that I am just volunteering my time and efforts when I can. I've already spent several hours on this problem, but I find myself short of time at the moment. Yes, it's possible to speed up the macro at the cost of more complexity. The way to do that is to read all the data at one time, which I already do with the Raw Data sheet, then write all the data at one time, which I don't do on the Sheet2, I write each cell individually. I made the changes to do that (wrote out an array for each area in MyDates), and it ran in a few seconds, but with zero values. In examining the sheet, I see that the layout has changed, so I don't know what should match with what.

In order to fix that, I'd need to spend more time conferring with you, but I don't have the time. :( Best recommendation is to find a consultant who has the time. There is a link at the top of this page for one option. You might try starting a new thread with "How to speed up this VBA" as the title, and post the macro, and maybe someone else will take a shot at it. It's short enough they might. (Use code tags if you do - people like well-formatted code and are more likely to look at it. When you lose all the indentations, it's hard to read.)

So good luck. If I get some more time, I may take a look at it, but don't count on it.
 
Upvote 0
I appreciate that you have a time crunch, however, please also understand that I am just volunteering my time and efforts when I can. I've already spent several hours on this problem, but I find myself short of time at the moment. Yes, it's possible to speed up the macro at the cost of more complexity. The way to do that is to read all the data at one time, which I already do with the Raw Data sheet, then write all the data at one time, which I don't do on the Sheet2, I write each cell individually. I made the changes to do that (wrote out an array for each area in MyDates), and it ran in a few seconds, but with zero values. In examining the sheet, I see that the layout has changed, so I don't know what should match with what.

In order to fix that, I'd need to spend more time conferring with you, but I don't have the time. :( Best recommendation is to find a consultant who has the time. There is a link at the top of this page for one option. You might try starting a new thread with "How to speed up this VBA" as the title, and post the macro, and maybe someone else will take a shot at it. It's short enough they might. (Use code tags if you do - people like well-formatted code and are more likely to look at it. When you lose all the indentations, it's hard to read.)

So good luck. If I get some more time, I may take a look at it, but don't count on it.

Eric, thank you for your time spent on this. I know it has been a lot to ask and I truly appreciate all the explanations. I will continue to look at the macro you wrote to try to understand why it is not working for me. I will also follow your advice and start a new threat in the hopes of getting feedback to speed it up based on your comments. If you do come across the time to take a look at the dropbox file to attempt the adjusted macro it would be great although I completely understand your time constraints.

have a great day
 
Upvote 0

Forum statistics

Threads
1,223,911
Messages
6,175,327
Members
452,635
Latest member
laura12345

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top