Subtotal according to changing number of columns

**josnah** · 01-11-2008, 09:59 PM

Hi I need help with the subtotal code:

Please see attached image to understand how my table will look like for a full year.

I need to produce YTD tables where not all months will be included.
For Jan YTD, my code will look like this:

Range("A3").Subtotal GroupBy:=1, Function:=xlSum, _
TotalList:=Array(3, 4), Replace:=True, _
PageBreaks:=False, SummaryBelowData:=True

For Jun YTD, my code will look like this:

Range("A3").Subtotal GroupBy:=1, Function:=xlSum, _
TotalList:=Array(3, 4, 5, 6, 7, 8, 9), Replace:=True, _
PageBreaks:=False, SummaryBelowData:=True

and for Dec YTD, my code will look like this:

Range("A3").Subtotal GroupBy:=1, Function:=xlSum, _
TotalList:=Array(3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True

How can i automate this instead of changing the array every month?
Any help is greatly appreciated!

**Leith Ross** · 01-12-2008, 04:10 AM

Hello josnah,

The easiest way to automate this would be to first create 3 separate macros in a Standard VBA module and then add 3 command buttons to your worksheet. Assign one macro to one button. Then you can click the button you want to display the required YTD totals.

Sincerely,
Leith Ross

**josnah** · 01-13-2008, 01:14 AM

hi Leith,

thanks for the suggestion. but then i'll need to create 12 seperate macros & commandbuttons for each month of the year.

but i was looking at sth more like...
if the 3rd last column is a particular month, then the array should change accordingly as listed below.

Month ArrayList
Jan 3,4
Feb 3,4,5
Mar 3,4,5,6
Apr 3,4,5,6,7
May 3,4,5,6,7,8
Jun 3,4,5,6,7,8,9
Jul 3,4,5,6,7,8,9,10
Aug 3,4,5,6,7,8,9,10,11
Sep 3,4,5,6,7,8,9,10,11,12
Oct 3,4,5,6,7,8,9,10,11,12,13
Nov 3,4,5,6,7,8,9,10,11,12,13,14
Dec 3,4,5,6,7,8,9,10,11,12,13,14,15

**Leith Ross** · 01-13-2008, 05:29 AM

Hello josnah,

This macro can be attached to a single button. It will prompt you for the month and then perform the YTD calculation.

Option Base 1

Sub YTDmacro()

  Dim MyArray As Variant
  Dim Reply

    Reply = InputBox("Enter the month using the first 3 letters.")
     'Did user choose Cancel?
      If Reply = "" Then Exit Sub

    Select Case LCase(Reply)
      Case Is = "jan"
        MyArray = Array(3,4)
      Case Is = "feb"
        MyArray = Array(3,4,5)
      Case Is = "mar"
        MyArray = Array(3,4,5,6)
      Case Is = "apr"
        MyArray = Array(3,4,5,6,7)
      Case Is = "may"
        MyArray = Array(3,4,5,6,7,8)
      Case is = "jun"
        MyArray = Array(3,4,5,6,7,8,9)
      Case Is = "jul"
        MyArray = Array(3,4,5,6,7,8,9,10)
      Case Is = "aug"
        MyArray = Array(3,4,5,6,7,8,9,10,11)
      Case Is = "sep"
        MyArray = Array(3,4),5,6,7,8,9,10,11,12)
      Case Is = "oct"
        MyArray = Array(3,4,5,6,7,8,9,10,11,12,13)
      Case Is = "nov"
        MyArray = Array(3,4,5,6,7,8,9,10,11,12,13,14)
      Case Is = "dec"
        MyArray = Array(3,4,5,6,7,8,9,10,11,12,13,14,15)
      Case Else
        MsgBox "Month " & Reply & " is invalid." 
        Exit Sub
    End Select 

    Range("A3").Subtotal GroupBy:=1, Function:=xlSum, _
      TotalList:=MyArray, Replace:=True, _
      PageBreaks:=False, SummaryBelowData:=True

End Sub

Sincerely,
Leith Ross