Extracting data between two given dates

Question

I have a table in excel having eight columns which includes year, date of deposit and total fees.

Now, if date of deposit is between two given dates and it pertains to year 2019-20 then I am trying to extract value from corresponding fee column. I am trying to get total fees deposited between two given dates for a particular year. But I am not getting desired result. Kindly help.

I am using If and Else statement and For Each loop.

Sub Macro12()
    Dim Cell As Range
    Dim Cell2 As Range

    For Each Cell In Range("D2:D25")
        ' If (Cell.Value >= DateValue("1 / 5 / 2019")) And (Cell.Value <= DateValue("30 / 4 / 2020")) Then
        If (Cell.Value >= 43586) And (Cell.Value <= 43951) Then
            For Each Cell2 In Range("C2:C25")
                If Cell2.Value = "2020-21" Then
                    Range("I3").Value = Cell2.Value
                    Range("J3").Value = Range("J3").Value + Cell2.Offset(0, 5).Value
                Else
                    Range("I4").Value = "other years"
                    Range("J4").Value = Range("J4").Value + Cell2.Offset(0, 5).Value
                End If
            Next Cell2
            ' ElseIf (Cell.Value >= DateValue("1 / 5 / 2021")) And (Cell.Value <= DateValue("30 / 4 / 2022")) Then
        ElseIf (Cell.Value >= 43599) And (Cell.Value <= 43599) Then
            Range("M3").Value = "step 1 clear"
        End If
    Next Cell
End Sub

Answer 1

If you want to do it with VAB I'd suggest to use ADODB for example like that

Sub ReadFromWorksheetADO()
    ' Goto Tools/Reference
    ' Add a reference to Microsoft ActiveX Data Objects
    Dim conn As New ADODB.Connection

    conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
        & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=YES;"";"

    Dim query As String
    query = "SELECT SUM([Total Fee]) FROM (SELECT * from [data$] " & _
        " WHERE [Date of Deposit] BETWEEN #04/30/2018# AND #05/01/2020# And [Year]='2020-21')"

    Dim rs As New ADODB.Recordset

    With rs
        .Open query, conn
        Debug.Print "Sum: " & .Fields(0)
    End With

End Sub

Assumption is that you have your data in a sheet named data

Answer 2

You don't show what you want for results, but you can use the Range.Autofilter method to extract the lines that meet your requirements. You could easily build in a method to extract just the fees.

eg:

Option Explicit
Sub getFees()
    Dim myData As Range
    Dim WS As Worksheet
    Dim ldtCol As Long, lyrCol As Long
    Dim lFeeCol As Long, lFee1Col As Long
    Dim dFees As Double
    Dim vFees As Variant, v As Variant


    Dim rFilteredData As Range, rDest As Range

    '"1 / 5 / 2019")) And (Cell.Value <= DateValue("30 / 4 / 2020
    'note these dates below are in MDY format
    Const startDt As Date = #5/1/2019#
    Const endDt As Date = #4/30/2020#
    Const applYr As String = "2020-21"

Set WS = ThisWorkbook.Worksheets("sheet1")
With WS.Cells
    Set myData = .Find(what:="S.No.", after:=.Item(.Rows.Count, .Columns.Count), _
            LookIn:=xlValues, lookat:=xlPart, searchorder:=xlByRows, searchdirection:=xlNext, _
            MatchCase:=False)
    If myData Is Nothing Then
        MsgBox "Data table not found"
    Else
        Set myData = myData.CurrentRegion
    End If
End With

With myData.Rows(1)
    ldtCol = .Find(what:="Date of Deposit").Column - myData.Column + 1
    lyrCol = .Find(what:="Year").Column - myData.Column + 1
    lFeeCol = .Find(what:="Base Fee", lookat:=xlWhole).Column - myData.Column + 1
    lFee1Col = .Find(what:="Base Fee2").Column - myData.Column + 1
End With


Application.ScreenUpdating = False
If WS.AutoFilterMode = True Then WS.AutoFilter.ShowAllData

With myData

    Set rDest = .Cells(1, 1).Offset(0, 10)
    rDest.Resize(columnsize:=.Columns.Count).EntireColumn.Clear

    .AutoFilter field:=lyrCol, Criteria1:=applYr
    .AutoFilter field:=ldtCol, Criteria1:=">=" & CDbl(startDt), _
        Operator:=xlAnd, Criteria2:="<=" & CDbl(endDt)

    Set rFilteredData = myData.SpecialCells(xlCellTypeVisible)
    Set rDest = .Cells(1, 1).Offset(0, 10)
    rDest.Resize(columnsize:=.Columns.Count).EntireColumn.Clear
    rFilteredData.Copy rDest
    .AutoFilter 'turn off filter
    rDest.EntireColumn.AutoFit

    With rDest.CurrentRegion
        vFees = Union(.Columns(lFeeCol), .Columns(lFee1Col))
    End With
        For Each v In vFees
            If IsNumeric(v) Then dFees = dFees + v
        Next v
    Application.ScreenUpdating = True

    MsgBox "Total Fees for period: " & dFees

End With

End Sub