Solved: Need to sum column totals for month. - My Code seems to be rounding cell values.

[frank_m]

The Function Sum_Visible_Cells seems to be rounding the cell values before giving me a sum total in a msgbox

See attached workbook where the Actual sum of all the totals for December is: 303,284.39

but the Sum totaled using code is: 303,281.00

Would someone be so kind as to point out why that is happening?

Thanks
[vba]
Private Sub CommandButton1_Click()
'modified slightly Code found at this link
'http://www.dailydoseofexcel.com/archives/2008/11/26/autofiltering-on-months/
Dim lMonth As Long, lYear As Long, rngCell As Range, rngCol As Range
Dim LastRow As Long, wks As Worksheet
Dim DateCell As Range, rng As Range, x As Long, LValue As String

Set wks = ActiveSheet
With wks
LastRow = ActiveSheet.Range("D" & Rows.Count).End(xlUp).Row

If ActiveCell.Row = 1 Or ActiveCell.Row > LastRow Then
MsgBox "Please select a row that has data"
Exit Sub
End If

Set rngCol = ActiveSheet.Range("D2" & LastRow) ' Cost Total Column
Set rngCell = Range("A2:A" & LastRow) ' Date Column

Set DateCell = ActiveCell.EntireRow.Cells(1)

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

x = Sum_Visible_Cells(rngCol)

LValue = Format(x, "Currency")

MsgBox LValue

Set rng = .Range(.Cells(1, 1), .Cells(LastRow, 4))

If Not rng Is Nothing Then
'turn filter off
.AutoFilterMode = False
'reset filter
rng.AutoFilter
.EnableAutoFilter = True
End If
End With

End Sub

Function Sum_Visible_Cells(Cells_To_Sum As Object)
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]

[Bob Phillips]

Firstly, I had to change the autofilter to work here in the UK. AUtofilter with dates is very flaky, and you have to take care.

Your problem was that the total variable was a long, so each time you accumulated into there, the pennies were lost.

[vba]
Private Sub CommandButton1_Click()
'modified slightly Code found at this link
'http://www.dailydoseofexcel.com/archives/2008/11/26/autofiltering-on-months/
Dim lMonth As Long, lYear As Long, rngCell As Range, rngCol As Range
Dim LastRow As Long, wks As Worksheet
Dim DateCell As Range, rng As Range, x As Double, LValue As String

Set wks = ActiveSheet
With wks
LastRow = ActiveSheet.Range("D" & Rows.Count).End(xlUp).Row

If ActiveCell.Row = 1 Or ActiveCell.Row > LastRow Then
MsgBox "Please select a row that has data"
Exit Sub
End If

Set rngCol = ActiveSheet.Range("D2" & LastRow) ' Cost Total Column
Set rngCell = Range("A2:A" & LastRow) ' Date Column

Set DateCell = ActiveCell.EntireRow.Cells(1)

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, _
">=" & Format(DateSerial(lYear, lMonth, 1), rngCell.Cells(2, 1).NumberFormat), _
xlAnd, _
"<=" & Format(DateSerial(lYear, lMonth + 1, 0), rngCell.Cells(2, 1).NumberFormat)
End With
End If
End If
End If
End If

x = Sum_Visible_Cells(rngCol)

LValue = Format(x, "Currency")

MsgBox LValue

Set rng = .Range(.Cells(1, 1), .Cells(LastRow, 4))

If Not rng Is Nothing Then
'turn filter off
.AutoFilterMode = False
'reset filter
rng.AutoFilter
.EnableAutoFilter = True
End If
End With

End Sub

Function Sum_Visible_Cells(Cells_To_Sum As Object)
Dim aCell As Range
Dim total As Double
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]

[Bob Phillips]

Also, that summation function seems overly-indulgent. Rather than the line to call it

[vba]
x = Sum_Visible_Cells(rngCol)[/vba]

why not just use

[vba]
x = Application.Sum(rngCol.SpecialCells(xlCellTypeVisible))[/vba]

[frank_m]

Thanks a lot Bob... for both getting the routine working correctly and the explanations.

why not just use
[vba]
x = Application.Sum(rngCol.SpecialCells(xlCellTypeVisible))[/vba]

Yes of course, that is so much simpler. - Not sure why I don't remember commands like that , as I know I've both seen and been supplied with it a few times

Your problem was that the total variable was a long, so each time you accumulated into there, the pennies were lost.

Awe yes, makes sense. Just another thing that I should know by now.

Firstly, I had to change the autofilter to work here in the UK. AUtofilter with dates is very flaky, and you have to take care.

Oh ok cool. I'll certainly will use that change as well, to make it more universal.

In case anyone happens by and wishes to use this, the version below incorporates your changes, plus I modified the sum total message to include the month and year.
[vba]Private Sub CommandButton1_Click()
'modified slightly Code found at this link
'http://www.dailydoseofexcel.com/archives/2008/11/26/autofiltering-on-months/
'If using a command button, I recommend changing the TakeFocusOnClick property to false
Dim lMonth As Long, lYear As Long, rngCell As Range, rngCol As Range
Dim LastRow As Long, wks As Worksheet
Dim DateCell As Range, rng As Range, x As Double, LValue As String

Set wks = ActiveSheet
With wks
LastRow = ActiveSheet.Range("D" & Rows.Count).End(xlUp).Row

If ActiveCell.Row = 1 Or ActiveCell.Row > LastRow Then
MsgBox "Please select a row that has data"
Exit Sub
End If

Set rngCol = ActiveSheet.Range("D2" & LastRow) ' Cost Total Column
Set rngCell = Range("A2:A" & LastRow) ' Date Column

Set DateCell = ActiveCell.EntireRow.Cells(1)

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, _
">=" & Format(DateSerial(lYear, lMonth, 1), rngCell.Cells(2, 1).NumberFormat), _
xlAnd, _
"<=" & Format(DateSerial(lYear, lMonth + 1, 0), rngCell.Cells(2, 1).NumberFormat)
End With
End If
End If
End If
End If

x = Application.Sum(rngCol.SpecialCells(xlCellTypeVisible))

LValue = "Grand total for " & MonthName(lMonth, False) _
& ", " & lYear & " is " & Format(x, "Currency")

MsgBox LValue

Set rng = .Range(.Cells(1, 1), .Cells(LastRow, 4))

If Not rng Is Nothing Then
'turn filter off
.AutoFilterMode = False
'reset filter
rng.AutoFilter
.EnableAutoFilter = True
End If
End With

End Sub[/vba]