Consulting

Results 1 to 4 of 4

Thread: Solved: Auto Filter by month of activecell, and subtotal result in a msgbox

  1. #1
    VBAX Expert
    Joined
    Sep 2010
    Posts
    604
    Location

    Solved: Auto Filter by month of activecell, and subtotal result in a msgbox

    Edit:#2 I was wrong, as the code is filtering ok, I just need the subtotal in a msgbox
    If I run this code with nothing filtered, it works well, but if a filtered is already applied, it is not replacing the previous filter results with the new results.

    Also: When I run this I can see the subtotal for the month of the activecell in the status bar. That's good, but how would I put it in a msgbox?

    Thanks - in advance

    Edit: Fixed a mistake where the active cell should be a pre-set varial instead
    [vba]
    Sub FilterOnMonth_Of_Date()
    'I modified slightly so that the appropriate columns are pre-determined
    'Code found at this link
    'http://www.dailydoseofexcel.com/archives/2008/11/26/autofiltering-on-months/
    Dim lMonth As Long
    Dim lYear As Long
    Dim rngCell As Range
    Dim rngCol As Range
    Dim LastRow As Long
    Dim wks As Worksheet
    Dim DateCell As Range
    Set wks = ActiveSheet
    With wks
    LastRow = ActiveSheet.Range("D" & Rows.Count).End(xlUp).Row - 1
    Set rngCol = ActiveSheet.Range("N16:N" & LastRow) ' Cost Total Column
    Set rngCell = Range("D151000") ' Date Column

    Set DateCell = ActiveCell.EntireRow.Cells(4)

    'I realized if I use this variable everywhere appropriate, there is no need to select.
    'DateCell.Select

    If Not rngCell Is Nothing Then

    If IsDate(DateCell.Value) Then
    lMonth = Month(DateCell.Value)
    lYear = Year(DateCell.Value)

    'Check if there is an autofilter
    If rngCell.Parent.AutoFilterMode Then

    'Make sure DateCell is within autofilter range
    If Not Intersect(DateCell, _
    rngCell.Parent.AutoFilter.Range) Is Nothing Then

    'Create filter
    With rngCell.Parent.AutoFilter
    .Range.AutoFilter DateCell.Column - .Range(1).Column + 1, _
    ">=" & DateSerial(lYear, lMonth, 1), _
    xlAnd, _
    "<=" & DateSerial(lYear, lMonth + 1, 0)
    End With
    End If
    End If
    End If
    End If

    rngCol.Select

    'wrong syntax to demonstrate what I am wishing for:
    'MsgBox Application.WorksheetFunction.Subtotal(Selection)
    End With
    [/vba]
    Last edited by frank_m; 01-04-2012 at 06:24 PM. Reason: Edit: Added missing End With into code

  2. #2
    VBAX Expert
    Joined
    Sep 2010
    Posts
    604
    Location
    I pieced this together from googling and it works fine.

    Can someone tell me what the command Application.Volatile is for, as it works with or without ion my case.

    Thanks
    [VBA]
    ' other code
    "<=" & DateSerial(lYear, lMonth + 1, 0)
    End With
    End If
    End If
    End If
    End If

    Dim x As Long
    Dim LValue As String

    x = Sum_Visible_Cells(rngCol)
    LValue = Format(x, "Currency")
    'http://www.techonthenet.com/excel/formulas/format_number.php
    MsgBox LValue
    End With
    End Sub
    Function Sum_Visible_Cells(Cells_To_Sum As Object)
    'http://support.microsoft.com/kb/150363
    Dim aCell As Range
    Dim total As Long
    Application.Volatile
    For Each aCell In Cells_To_Sum
    If aCell.Rows.Hidden = False Then
    'If aCell.Columns.Hidden = False Then
    total = total + aCell.Value
    'End If
    End If
    Next
    Sum_Visible_Cells = total
    End Function
    [/VBA]

  3. #3
    Knowledge Base Approver VBAX Guru GTO's Avatar
    Joined
    Sep 2008
    Posts
    3,368
    Location
    Hi Frank :-)

    Application.Volatile only affects calculation if the Function is being called from a sheet (i.e. - being used as a User Defined Function). In that case, the function is volatile and recalculates anytime any cell on the sheet calculates (like NOW()).

  4. #4
    VBAX Expert
    Joined
    Sep 2010
    Posts
    604
    Location
    Thanks for the explanation Mark

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •