Put Row of range in variable (Long) if first occurrence cell contains today?-CodePudding

in my workbook Column I contains Dates. I can get last Row easily by:

 Dim LastRow As Long
 LastRow = ActiveSheet.Cells(Rows.Count, "I").End(xlUp).Row

I need to put Row of that column in variable (Long) if first occurrence cell contains today.
actually , the expected code like this:

 Set Rng = ActiveSheet.Range("I" & FirstRow & ":I" & LastRow)

Note: using VBA AutoFilter is not applicable on my workbook , Because it is protected and shared on the same time

Link for the sample Sheet

CodePudding user response：

Please, test the next simple code. All credit should go to @Simon, who clearly described what is to be done. I only put it in place, using a Variant (mtch) variable, able to be checked even if an error (in case of no any match) occurs:

 Sub testFirstLastCell()
Sub testFirstLastCell()
   Dim sh As Worksheet, firstCell As Long, lastCell As Long, rng As Range, mtch
   
   Set sh = ActiveSheet 'use here the sheet you need
   lastCell = sh.Range("I" & sh.rows.Count).End(xlUp).row
   mtch = Application.match(CLng(Date), sh.Range("I1:I" & lastCell), 0)
   If IsNumeric(mtch) Then
        firstCell = mtch
        Set rng = sh.Range("I" & firstCell, "I" & lastCell)
  Else
        MsgBox "Today date could not be found..."
  End If
  If Not rng Is Nothing Then Debug.Print rng.Address
End Sub

Edited:

Since your data in I:I does mean Time (something as 03.01.2022 21:27:37), the range must be corrected for the Date Long value to be matched. Please, test the updated code:

Sub firstCellTest()
   Dim sh As Worksheet, firstCell As Long, lastCell As Long, rng As Range, mtch, arr
   
   Set sh = ActiveSheet
   lastCell = sh.Range("I" & sh.rows.Count).End(xlUp).row
   Set rng = sh.Range("I1:I" & lastCell)
   arr = Evaluate("int(" & rng.Address & ")") 'place in an array only the Date part of existing time
   mtch = Application.match(CLng(Date), arr, 0)
   If IsNumeric(mtch) Then
        firstCell = mtch
        Set rng = sh.Range("I" & firstCell, "I" & lastCell)
  Else
        MsgBox "Today date could not be found..."
  End If
  If Not rng Is Nothing Then Debug.Print rng.Address
End Sub

CodePudding user response：

Reference a Range Using the Find Method

This solution will find the first occurrence of today's date in a column and create a reference to the range from this cell to the bottom-most non-empty cell in the same column.
The RefTodaysRangeTEST procedure illustrates how to use the RefTodaysRange function (the way to go).
The TodaysRange procedure does the same thing without using a function yet cluttering your code.
The TodaysRangeDebugPrintStudy procedure prints the range addresses at the various stages to the Immediate window (Crtl G).

Option Explicit

Sub RefTodaysRangeTEST()

    Const fCellAddress = "A3"
    
    Dim ws As Worksheet: Set ws = ActiveSheet
    Dim fCell As Range: Set fCell = ws.Range(fCellAddress)
    Dim trg As Range: Set trg = RefTodaysRange(fCell)
    
    ' Continue, e.g.:
    If Not fCell Is Nothing Then
        MsgBox "Today's Range Address: " & trg.Address(0, 0)
    Else
        MsgBox "Today's Range Address: not available."
    End If

End Sub


Function RefTodaysRange( _
    FirstCell As Range) _
As Range
    If FirstCell Is Nothing Then Exit Function
    
    Dim lCell As Range ' last (bottom-most) non-empty cell
    Dim fCell As Range ' first (top-most) cell containing today's date
    
    With FirstCell
        
        Dim crg As Range
        Set crg = .Resize(.Worksheet.Rows.Count - .Row   1)
        Set lCell = crg.Find("*", , xlFormulas, , , xlPrevious)
        If lCell Is Nothing Then Exit Function ' no data
    
        Set crg = .Resize(lCell.Row - .Row   1)
        Set fCell = crg.Find(Date, lCell, xlValues, xlWhole)
        If fCell Is Nothing Then Exit Function ' today's date not found
    
    End With
    
    Set RefTodaysRange = fCell.Resize(lCell.Row - fCell.Row   1)

End Function


Sub TodaysRange()
    
    Const fCellAddress = "A3"
    
    Dim ws As Worksheet: Set ws = ActiveSheet
    
    Dim fCell As Range: Set fCell = ws.Range(fCellAddress)
    
    Dim crg As Range: Set crg = fCell.Resize(ws.Rows.Count - fCell.Row   1)
    
    Dim lCell As Range: Set lCell = crg.Find("*", , xlFormulas, , , xlPrevious)
    If lCell Is Nothing Then Exit Sub ' no data from 'fCell' to the bottom
    
    Set crg = fCell.Resize(lCell.Row - fCell.Row   1)
    
    Set fCell = crg.Find(Date, lCell, xlValues, xlWhole)
    If fCell Is Nothing Then Exit Sub ' today's date not found
    
    Set crg = ws.Range(fCell, lCell)

End Sub

Sub TodaysRangeDebugPrintStudy()
    
    Const fCellAddress = "A3"
    
    Dim ws As Worksheet: Set ws = ActiveSheet
    Debug.Print "Worksheet:    " & ws.Name
    
    Dim fCell As Range: Set fCell = ws.Range(fCellAddress)
    Debug.Print "First Cell:   " & fCell.Address(0, 0)
    
    Dim crg As Range: Set crg = fCell.Resize(ws.Rows.Count - fCell.Row   1)
    Debug.Print "Column Range: " & crg.Address(0, 0)
    
    Dim lCell As Range: Set lCell = crg.Find("*", , xlFormulas, , , xlPrevious)
    If lCell Is Nothing Then Exit Sub ' no data from 'fCell' to the bottom
    Debug.Print "Last Cell:    " & lCell.Address(0, 0)
    
    Set crg = fCell.Resize(lCell.Row - fCell.Row   1)
    Debug.Print "Column Range: " & crg.Address(0, 0)
    
    Set fCell = crg.Find(Date, lCell, xlValues, xlWhole)
    If fCell Is Nothing Then Exit Sub ' today's date not found
    Debug.Print "First Cell:   " & fCell.Address(0, 0)
    
    Set crg = ws.Range(fCell, lCell)
    Debug.Print "Column Range: " & crg.Address(0, 0)

End Sub