Advanced Filter and Multi Graphing

[RINCONPAUL]

I have a dataset of 400k rows. Each day I need to perform several hundred filters and graph each one. Each row of data comprises a BSP value,DIV$ value and these are derived by using a combination of three references #1, #2, #3.

From the abridged table attached, I elect to interrogate the characteristics of the combination 2-2-1. This requires the dataset to be filtered into 4 possible combinations: 2-2-1, 2-2-*, 2-*-1, *-2-1. These four separate series of actions to filter each scenario to a different sheet, takes too much time.

On the attachment, the 'Base' sheet shows the wish list appearance of the final result i.e. The four graphs plotted consecutively, one above the other for a quick view. (I've achieved this by a snipping tool). After looking at the four tiled graphs, I would be able to 'clear all', re enter a new combination in I1:K1 and the new graphs appear below.

The purpose of the strategy is to 'at a glace' look for values on the 'blue' line that are profitable (a rising red line) in all four instances. In this example it would be a BSP range of 0 to 4. A couple of things, there is a subtotal column that adds the visible DIV$ using the SUBTOTAL function for each graph. As the dataset is large, this function slows the processor down markedly. So bad in fact, that when I copy the filtered data from the 'Base' sheet to another sheet, I don't copy & paste the Sub Total column, only the BSP & DIV$ cols and then plot a simple A+B result to achieve a running subtotal. Not sure if there's a better way?

So the solution required by my post is, " Can you loop a vba routine to create 4 stacked graphs (incl secondary Y axis) on the 'Base' sheet for each possible combination of three numbers?"....without the computer taking several minutes to achieve the task? (computer i7, 16GB RAM)

[p45cal]

Button in the vicinity of cell D2 in the attached renews 4 pictures of charts.
I moved the data down below row 40 as the hiding/showing of rows with advanced filter was screwing their sizes up.
You will need to tweak the ranges in the code to accommodate your real data.
I had to change the #1,#2,#3 headers to Num1, Num2 etc. as Advanced filter did not like them.
Manually change the 4 filters in I1:K4 and click the button to delete and re-create the 4 chart pictures.

I think you may have to keep the subtotals as the values change depending on what's showing. The attached sheet has a hotchpotch of calculations in column B, I don't think it was me that changed them. This will be important to give you the charts you want.

Speed? Well, you'll have to report back on that one.

[RINCONPAUL]

Pascal, thankyou for your reply. All is not good though. In your workout, range B42:B61 contains a mix of cell + cell and SUBTOTAL(9,Range) formula. They should be all SUBTOTALs I believe? If you change the criteria to 1-1-1 say, only two records match. The LH X axis scale is not reflecting the true sub totals 334(0+334) and 514(334+180).

That aside, I have progressed with this since my first post. With 400k rows to sort, the SUBTOTAL formula just crashes excel. What I do is manually select the combinations using FILTER, then use vba to copy the new col length to Sheet2 where it inserts a simple Row1cell+Row2cell+Row3cell....to work out the running totals. Then I trigger another VBA to graph it using OFFSET to adjust for range. It means I can only do one combination at a time but at least the computer doesn't freeze.
Cheers

[snb]

I made something with advancedfilter & sum(): no subtotal needed.

[p45cal]

In your workout, range B42:B61 contains a mix of cell + cell and SUBTOTAL(9,Range) formula.

I said as much in my message:

The attached sheet has a hotchpotch of calculations in column B, I don't think it was me that changed them.

See attached which has been tweaked to accommodate snb's idea.

[Paul_Hossler]

I'd do a simple process to a temp sheet for the 4 options and make the charts off of that sheet

Option Explicit
Sub UpdateCharts()
    Dim wsTemp As Worksheet, wsBase As Worksheet
    Dim rBase As Range, rChartSource As Range
    
    Set wsBase = Worksheets("Base")
    Set rBase = wsBase.Cells(6, 1).CurrentRegion
    Set rBase = rBase.Cells(2, 1).Resize(rBase.Rows.Count - 1, rBase.Columns.Count)
    
    
    Application.ScreenUpdating = False
    
    'remove and create new Temp, clear names
    On Error Resume Next
    Application.DisplayAlerts = False
    Worksheets("Temp").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    
    Worksheets.Add
    Set wsTemp = ActiveSheet
    wsTemp.Name = "Temp"
    
    If wsBase.AutoFilterMode Then wsBase.AutoFilterMode = False
    rBase.Rows(1).AutoFilter
    
    'add first filter 2-2-1
    rBase.AutoFilter Field:=4, Criteria1:="2"
    rBase.AutoFilter Field:=5, Criteria1:="2"
    rBase.AutoFilter Field:=6, Criteria1:="1"
    Call wsBase.AutoFilter.Range.Copy
    wsTemp.Select
    wsTemp.Cells(1, 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    wsBase.AutoFilterMode = False
    'add second filter 2-2-0
    rBase.AutoFilter Field:=4, Criteria1:="2"
    rBase.AutoFilter Field:=5, Criteria1:="2"
    Call wsBase.AutoFilter.Range.Copy
    wsTemp.Select
    wsTemp.Cells(1, 8).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    wsBase.AutoFilterMode = False

    'add third filter 2-0-1
    rBase.AutoFilter Field:=4, Criteria1:="2"
    rBase.AutoFilter Field:=6, Criteria1:="1"
    Call wsBase.AutoFilter.Range.Copy
    wsTemp.Select
    wsTemp.Cells(1, 15).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    wsBase.AutoFilterMode = False

    'add fourth filter 0-2-1
    rBase.AutoFilter Field:=5, Criteria1:="2"
    rBase.AutoFilter Field:=6, Criteria1:="1"
    Call wsBase.AutoFilter.Range.Copy
    wsTemp.Select
    wsTemp.Cells(1, 22).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    wsBase.AutoFilterMode = False
    
    'update series
    With Worksheets("Charts")
        Application.DisplayAlerts = False
        Set rChartSource = wsTemp.Cells(1, 1).CurrentRegion
        Set rChartSource = rChartSource.Cells(1, 1).Resize(rChartSource.Rows.Count, 2)
        .ChartObjects("Chart 1").Activate
        ActiveChart.SetSourceData Source:=rChartSource
        Set rChartSource = wsTemp.Cells(1, 8).CurrentRegion
        Set rChartSource = rChartSource.Cells(1, 1).Resize(rChartSource.Rows.Count, 2)
        .ChartObjects("Chart 2").Activate
        ActiveChart.SetSourceData Source:=rChartSource
        
        Set rChartSource = wsTemp.Cells(1, 15).CurrentRegion
        Set rChartSource = rChartSource.Cells(1, 1).Resize(rChartSource.Rows.Count, 2)
        .ChartObjects("Chart 3").Activate
        ActiveChart.SetSourceData Source:=rChartSource

        Set rChartSource = wsTemp.Cells(1, 22).CurrentRegion
        Set rChartSource = rChartSource.Cells(1, 1).Resize(rChartSource.Rows.Count, 2)
        .ChartObjects("Chart 4").Activate
        ActiveChart.SetSourceData Source:=rChartSource
        Application.DisplayAlerts = True
    End With
    
    wsTemp.Visible = xlSheetHidden
    
    Application.ScreenUpdating = True
    Worksheets("Charts").Select
End Sub

[RINCONPAUL]

Pascal, I've only had time to test this quickly on a small dataset, but on the surface appears a very good solution. If you've been able to overcome the critical slowing of the computer crunching those SUBTOTAL's then that's fantastic! You're like a champion high jumper, I set the bar higher, you still sail over it. I'll report back tomorrow on a big test.

As always, thankyou so much.

[RINCONPAUL]

Paul,

Thankyou for your input. I did a quick test and there were some issues, however, will sit down to look at it more closely tomorrow. Get back to you then.

Cheers

[RINCONPAUL]

When it's knock off time, most people are out the door with a rush. But there's always the few who hang back to finish something off. Then there's a very select few who, even when they're finished, push the boundaries even more to improve on where they finished off!
p45cal (Pascal) is one such individual, and in his own time has taken my code request to new heights.

Great work Pascal.