Count rows that only have cetrain date values in all colums-CodePudding

So im a complete VBA newbie and i kinda need help to solve a problem that seems to reqire a Excel VBA script. I got a Excel chart with a buch of dates and other values. I need to find all the rows that have dates in them older than the current date (Lets say the current date is 23.03.2022), all dates in that row need to be older and ther need to be dates only in the row, for the row to be counted. At the end I need to find out how many rows there are and paste that number in to a certain cell.

Example cahrt

So for example at the end id get the ouput that there is 1 row with dates older than the current one. because the other rows either have at least one future date, at least one empty cell or cells that contain something other than a date.

I have tried cetrain nubers of excel functions and i also tried to make sperate charts es sub steps for the functions but i didnt get it to work. so i figured id give VBA a shot but i got no experience inanything other than Java an C .

CodePudding user response：

Count Date Rows UDF

Counts the number of rows of a range where all cells contain a date earlier than a given date.
If no given date, today's date is used.
If a cell in a row contains anything that is not a date, it is 'disqualified'.

In Excel use (according to the posted image)

=CountDateRows(B2:D4)
=CountDateRows(B2:D4,DATE(2022,3,22))
=CountDateRows(Sheet2!B2:D4,DATE(2022,3,22))
=CountDateRows(Sheet2!B2:D4,A1) ' A1 contains a date

The Code in a Standard Module, e.g. Module1

Option Explicit

Function CountDateRows( _
    ByVal rg As Range, _
    Optional ByVal InitialDate As Variant) _
As Long
    
    If IsMissing(InitialDate) Then InitialDate = Date
    
    Dim rCount As Long: rCount = rg.Rows.Count
    Dim cCount As Long: cCount = rg.Columns.Count
    
    Dim Data As Variant
    
    If rCount   cCount = 2 Then
        ReDim Data(1 To 1, 1 To 1): Data(1, 1).Value = rg.Value
    Else
        Data = rg.Value
    End If
    
    Dim cValue As Variant
    Dim r As Long
    Dim c As Long
    Dim fCount As Long ' Number of Found Rows
    Dim IsOk As Boolean
    
    For r = 1 To rCount
        For c = 1 To cCount
            cValue = Data(r, c)
            If IsDate(cValue) Then
                If cValue < InitialDate Then IsOk = True
            End If
            If IsOk Then IsOk = False Else Exit For
        Next c
        If c > cCount Then fCount = fCount   1
    Next r
    
    CountDateRows = fCount
    
End Function