SumbyColour and Sumifs combined

[annaisakiwi]

Hi all

I have a SumByColour writen in VBA - however i'm wanting to change this slightly to include a sumifs

I want the Sum calculation to only total values between two dates. A date will be entered in for the Leave as at date (E3) - and I want the SumbyColor to only sum between this entered date and the date in $D6 to give me the total in the Annual Leave Booked cell - in this instance in G6.

Really appreciate anyones help with this!

Dim cf As New Class1

Sub Auto_Open()
    Set cf.cX = Application.CommandBars
End Sub

Sub Auto_Close()
    Set cf.cX = Nothing
End Sub

Function GetCellColor(xlRange As Range)
            Dim indRow, indColumn As Long
            Dim arResults()
     
            Application.Volatile
     
            If xlRange Is Nothing Then
                    Set xlRange = Application.ThisCell
            End If
     
            If xlRange.Count > 1 Then
                ReDim arResults(1 To xlRange.Rows.Count, 1 To xlRange.Columns.Count)
                 For indRow = 1 To xlRange.Rows.Count
                     For indColumn = 1 To xlRange.Columns.Count
                         arResults(indRow, indColumn) = xlRange(indRow, indColumn).Interior.Color
                     Next
                 Next
             GetCellColor = arResults
            Else
             GetCellColor = xlRange.Interior.Color
            End If
    End Function
     
    Function GetCellFontColor(xlRange As Range)
            Dim indRow, indColumn As Long
            Dim arResults()
     
            Application.Volatile
     
            If xlRange Is Nothing Then
                    Set xlRange = Application.ThisCell
            End If
     
            If xlRange.Count > 1 Then
                ReDim arResults(1 To xlRange.Rows.Count, 1 To xlRange.Columns.Count)
                 For indRow = 1 To xlRange.Rows.Count
                     For indColumn = 1 To xlRange.Columns.Count
                         arResults(indRow, indColumn) = xlRange(indRow, indColumn).Font.Color
                     Next
                 Next
             GetCellFontColor = arResults
            Else
             GetCellFontColor = xlRange.Font.Color
            End If
     
    End Function
     
    Function CountCellsByColor(rData As Range, cellRefColor As Range) As Long
            Dim indRefColor As Long
            Dim cellCurrent As Range
            Dim cntRes As Long
     
            Application.Volatile
            cntRes = 0
            indRefColor = cellRefColor.Cells(1, 1).Interior.Color
            For Each cellCurrent In rData
                    If indRefColor = cellCurrent.Interior.Color Then
                            cntRes = cntRes + 1
                    End If
            Next cellCurrent
     
            CountCellsByColor = cntRes
    End Function
     
    Function SumCellsByColor(rData As Range, cellRefColor As Range)
            Dim indRefColor As Long
            Dim cellCurrent As Range
            Dim sumRes
     
            Application.Volatile
            sumRes = 0
            indRefColor = cellRefColor.Cells(1, 1).Interior.Color
            For Each cellCurrent In rData
                    If indRefColor = cellCurrent.Interior.Color Then
                            sumRes = WorksheetFunction.Sum(cellCurrent, sumRes)
                    End If
            Next cellCurrent
     
            SumCellsByColor = sumRes
    End Function
     
    Function CountCellsByFontColor(rData As Range, cellRefColor As Range) As Long
            Dim indRefColor As Long
            Dim cellCurrent As Range
            Dim cntRes As Long
     
            Application.Volatile
            cntRes = 0
            indRefColor = cellRefColor.Cells(1, 1).Font.Color
            For Each cellCurrent In rData
                    If indRefColor = cellCurrent.Font.Color Then
                            cntRes = cntRes + 1
                    End If
            Next cellCurrent
     
            CountCellsByFontColor = cntRes
    End Function
     
    Function SumCellsByFontColor(rData As Range, cellRefColor As Range)
            Dim indRefColor As Long
            Dim cellCurrent As Range
            Dim sumRes
     
        Application.Volatile
            sumRes = 0
            indRefColor = cellRefColor.Cells(1, 1).Font.Color
            For Each cellCurrent In rData
                    If indRefColor = cellCurrent.Font.Color Then
                            sumRes = WorksheetFunction.Sum(cellCurrent, sumRes)
                    End If
            Next cellCurrent
     
            SumCellsByFontColor = sumRes
    End Function

 

[severynm]

Add two variables to your code, one for each date you are summing between. After that, just wrap your sum statement inside another if:

if cellCurrent.Value > startDate and cellCurrent.Value < endDate Then
    sumRes = sumRes + cellCurrent.Value
end if