Using Countif formula in vb

[spittingfire]

Hi All.

I have a simple attached test workbook (test_file.xlsx) that only have a date column.

What I want to do is from a new workbook I want to apply the following formulas using vba
=COUNTIF(A:A,"="&TODAY())
=COUNTIF(A:A,"<="&TODAY()-2)
=COUNTIF(A:A,">"&TODAY())

and return the values in the current workbook in cells

B1
B2
B3


The data sheet will have new data on a daily basis but all I care about is the data in column A.

For simplicity purposes the workbook is located in C:\test_file.xlsx

Will be nice if the vb can perform the calculations while the other workbook is closed but not that important if it's not possible.

Any assistance will be appreciated.

Thanks

[Kenneth Hobs]

If the date file is open, then the usual reference would suffice.
e.g. =COUNTIF([test_file.xlsx]Sheet1!$A:$A,"="&TODAY())

[spittingfire]

Thanks Kenneth, that is something that I'm aware of but actually what I would prefer is to have a script of some kind to fetch the sheet and do the calculation and paste the results in B1, B2 and B3 of the new workbook.

[Kenneth Hobs]

It is a simple matter. Did you need help with that? A recorded macro should get you most of the way there. You can easily record opening the date file or a copy of it to open, and then add the "formula" as a string for the 3 ranges, and then close the date file.

Another method one can do is to use a formula to add all of the date file's data sheet. Then your formula(s) would reference that sheet's column A data.

An even more involved method is to use ADO. Of course then your data would be static.

[JKwan]

Give your data a header, I called it DATE. Give this a try

Option Explicit
Sub FetchData()
    ' Need to reference Microsoft ActiveX Data Objects 2.x
    Dim stSQLstring As String
    
    Application.ScreenUpdating = False
    
    stSQLstring = "Select Count([Date]) From " & _
                  "[Sheet1$] Where [Date] = #" & Format(Now, "mm/dd/yyyy") & "#" & _
                  ";"
    QueryWorksheet stSQLstring, _
                   Sheet1.Range("B1"), _
                   "C:\test\test_file.xlsx"
                  
    stSQLstring = "Select Count([Date]) From " & _
                  "[Sheet1$] Where [Date] <= #" & Format(Now - 2, "mm/dd/yyyy") & "#" & _
                  ";"
    QueryWorksheet stSQLstring, _
                   Sheet1.Range("B2"), _
                   "C:\test\test_file.xlsx"
    
    stSQLstring = "Select Count([Date]) From " & _
                  "[Sheet1$] Where [Date] > #" & Format(Now, "mm/dd/yyyy") & "#" & _
                  ";"
    QueryWorksheet stSQLstring, _
                   Sheet1.Range("B3"), _
                   "C:\test\test_file.xlsx"
    Application.ScreenUpdating = True
End Sub
Public Sub QueryWorksheet(szSQL As String, rgStart As Range, wbWorkBook As String)
    Dim rsData As ADODB.Recordset
    Dim szConnect As String
    
    On Error GoTo ErrHandler
    Application.StatusBar = "Retrieving data ....."
    szConnect = "Provider = Microsoft.ACE.OLEDB.12.0;" & _
                "Data Source=" & wbWorkBook & ";" & _
                "Extended Properties=Excel 12.0;"
     
    Set rsData = New ADODB.Recordset
    rsData.Open szSQL, szConnect, adOpenForwardOnly, adLockReadOnly, adCmdText
     
    If Not rsData.EOF Then
        rgStart.CopyFromRecordset rsData
    Else
        MsgBox "There is no records that matches the query !!", vbCritical
    End If
    rsData.Close
    Set rsData = Nothing
    Application.StatusBar = False
    Exit Sub
ErrHandler:
     'an error occured in the SQL-statement
    MsgBox "Your query could not be executed, the SQL-statement is incorrect."
    Set rsData = Nothing
    Application.StatusBar = False
End Sub

[JKwan]

by the way, if you don't want to put header onto your data, use this

Option Explicit
Sub FetchData()
    ' Need to reference Microsoft ActiveX Data Objects 2.x
    Dim stSQLstring As String
    
    Application.ScreenUpdating = False
    
    stSQLstring = "Select Count([F1]) From " & _
                  "[Sheet1$] Where [F1] = #" & Format(Now, "mm/dd/yyyy") & "#" & _
                  ";"
    QueryWorksheet stSQLstring, _
                   Sheet1.Range("B1"), _
                   "C:\test\test_file.xlsx"
                  
    stSQLstring = "Select Count([F1]) From " & _
                  "[Sheet1$] Where [F1] <= #" & Format(Now - 2, "mm/dd/yyyy") & "#" & _
                  ";"
    QueryWorksheet stSQLstring, _
                   Sheet1.Range("B2"), _
                   "C:\test\test_file.xlsx"
    
    stSQLstring = "Select Count([F1]) From " & _
                  "[Sheet1$] Where [F1] > #" & Format(Now, "mm/dd/yyyy") & "#" & _
                  ";"
    QueryWorksheet stSQLstring, _
                   Sheet1.Range("B3"), _
                   "C:\test\test_file.xlsx"
    Application.ScreenUpdating = True
End Sub
Public Sub QueryWorksheet(szSQL As String, rgStart As Range, wbWorkBook As String)
    Dim rsData As ADODB.Recordset
    Dim szConnect As String
    
    On Error GoTo ErrHandler
    Application.StatusBar = "Retrieving data ....."
    szConnect = "Provider = Microsoft.ACE.OLEDB.12.0;" & _
                "Data Source=" & wbWorkBook & ";" & _
                "Extended Properties=""Excel 12.0;HDR=NO;FMT=Delimited"""
     
    Set rsData = New ADODB.Recordset
    rsData.Open szSQL, szConnect, adOpenForwardOnly, adLockReadOnly, adCmdText
     
    If Not rsData.EOF Then
        rgStart.CopyFromRecordset rsData
    Else
        MsgBox "There is no records that matches the query !!", vbCritical
    End If
    rsData.Close
    Set rsData = Nothing
    Application.StatusBar = False
    Exit Sub
ErrHandler:
     'an error occured in the SQL-statement
    MsgBox "Your query could not be executed, the SQL-statement is incorrect."
    Set rsData = Nothing
    Application.StatusBar = False
End Sub

[Kenneth Hobs]

Here is the formula method played from the Date file. Uncomment the Value line if you want data static.

Sub Main()  
  Dim s As String
  
  Application.EnableEvents = False
  Application.DisplayAlerts = False
  
  s = "=COUNTIF('[" & ThisWorkbook.Name & "]Sheet1'!$A:$A,"
  With Workbooks.Add
    'DoEvents 'Allow time for workbook to open
    Range("B1").Formula = s & """=""&TODAY())"
    Range("B2").Formula = s & """<=""&TODAY()-2)"
    Range("B3").Formula = s & """>""&TODAY())"
    'Range("B1:B3").Value = Range("B1:B3").Value 'Make formula result static.
    .SaveAs ThisWorkbook.Path & "\spittingfire.xlsx", _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
  End With
  ThisWorkbook.Close
  
  Application.EnableEvents = True
  Application.DisplayAlerts = True
End Sub

[spittingfire]

Thanks to you both Kenneth Hobs and JKwan for your help. Much appreciated. Both methods work well. I can only give one reputation in 24 hours and you both certainly deserve one. I will add the other reputation in 24 hours. Again much appreciated.