VBA: Select Range in Current Week

[zero269]

Hello,

I'm trying to figure out how I can select a range based on a date within the current week.

Example of selection…

The order I'm trying to step through is the following:

1. Declare Friday as a variable to store the date using a formula: =TODAY()-WEEKDAY(TODAY(),16)+7
As of today, the date would be 1-Sep stored in the Friday variable
VBA obviously rejects this method and I couldn't find any examples online

2. Find first cell in column that is greater than the Friday variable; first row would be 5-Sep in the image
Offset it by -1 row and store that Row # inside a LastRow variable

3. Select Range "A2:LastRow"


I'm at a complete loss right now. Any guidance would be greatly appreciated.

 

[zero269]

OK, so it looks like I was able to get the date now:

Friday = Date - Weekday(Date, vbSaturday) + 7

This returns 2023-09-01

Note: I'm using vbSaturday for the 1st day of the week so the last day falls on a Friday.

 

[kevin9999]

There's probably a more elegant way, but this seems to work:

Option Explicit
Sub zero269()
    Dim ws As Worksheet, d As Date, LRow As Long, i As Long
    Set ws = Worksheets("Sheet1")       '<-- *** Change to actual sheet name ***
    
    d = [TODAY()-WEEKDAY(TODAY(),16)+7]
        For i = ws.Cells(Rows.Count, "D").End(xlUp).Row To 2 Step -1
            If ws.Cells(i, "D") <= d Then
                LRow = i
                Exit For
            End If
    Next i
    ws.Range("A1:D" & LRow).Select
End Sub

 

[zero269]

Looks like I was able to stitch something together using two different examples I found in this forum.

It's not pretty, but here's what I got working:

Sub SelectCurrentWeek()

'Get Friday's Date
    Dim Friday As Date
    Friday = Date - Weekday(Date, vbSaturday) + 7
    
'Get "Test Date" column number
    Dim TestDate As Integer
    TestDate = ActiveSheet.ListObjects(1).ListColumns("Test Date").Index
    
'Select Test Date Data Body Range
    Dim colRange As Range
    ActiveSheet.ListObjects(1).ListColumns("Test Date").DataBodyRange.Select
    Set colRange = Selection
    
    Dim cell As Range
    Dim LastRow As Long
    
    For Each cell In colRange
        If cell.Value > Friday Then
            LastRow = cell.row
            Exit For
        End If
    
    Next
    
    Range("A2:F" & LastRow).Select

End Sub

 

[zero269]

There's probably a more elegant way, but this seems to work:

Option Explicit
Sub zero269()
    Dim ws As Worksheet, d As Date, LRow As Long, i As Long
    Set ws = Worksheets("Sheet1")       '<-- *** Change to actual sheet name ***
   
    d = [TODAY()-WEEKDAY(TODAY(),16)+7]
        For i = ws.Cells(Rows.Count, "D").End(xlUp).Row To 2 Step -1
            If ws.Cells(i, "D") <= d Then
                LRow = i
                Exit For
            End If
    Next i
    ws.Range("A1:D" & LRow).Select
End Sub

Hi Kevin,

Thanks for the code. I tried it out, but it's selecting all the rows, including the Totals Row.
Note: I ran your code after updating my Sheet Name and Column reference; F in my main workbook; D in my Sample question.

I stepped through your code, and I can see it's grabbing:

d = #2023-09-01# which is the correct date
LRow = 0 starting value
i = 16 this is the Totals Row during my testing
Then LRow picked up the i value of 16
Then it went right into selecting the range using: A2:F16

It appears to me that the reason that it's failing is because it's starting in my Totals Row which is empty. So I added the MAX date and tested it again.

It was SUCCESSFUL this time. Perhaps there's a way to account for the Totals Row in a Table to prevent it from failing in other use cases.

The code that I scraped together starts at the top and works its way down.

Noticed Issue with my code:
After checking my code again, I realized I forgot to Offset my LastRow by -1. I just noticed it's selecting an extra row in my case.

 

[kevin9999]

Try changing this line to (I changed it to column F)

For i = ws.Cells(Rows.Count, "F").End(xlUp).Row-1 To 2 Step -1

 

[zero269]

Try changing this line to (I changed it to column F)

For i = ws.Cells(Rows.Count, "F").End(xlUp).Row-1 To 2 Step -1

Hi Kevin,

That certainly did the trick. I removed the Max date from the Totals Row as well, and it worked as expected considering you're going up a row.

Your before and after:

[FONT=Segoe UI Light]For i = ws.Cells(Rows.Count, "F").End(xlUp).row To 2 Step -1 'BEFORE
For i = ws.Cells(Rows.Count, "F").End(xlUp).row - 1 To 2 Step -1 'AFTER[/FONT]

You could use the following to "Select a specific column within the totals section":

[FONT=Segoe UI Light]Sub SelectCellInTotal()
    ActiveSheet.ListObjects("tblSelectTest").TotalsRowRange(5).Select
End Sub[/FONT]

This requires hardcoding the Table Name and Column reference.

[FONT=Segoe UI Light]ActiveSheet.ListObjects(1).TotalsRowRange(5).Select 'When you know there's only one table object[/FONT]

To get the Column Number based on the Column Heading, I like to use the code you saw in mine:

[FONT=Segoe UI Light]TestDate = ActiveSheet.ListObjects(1).ListColumns("Test Date").Index 'Get "Test Date" column number[/FONT]

Maybe you could validate if the Totals Row is active and then only offset by -1 row when needed…

I got these Table examples from here: VBA Tables and ListObjects - Excel Off The Grid and they've proven useful for me.

Thanks again and best regards,

 

[zero269]

CODE CORRECTED:

I had to offset my code as well by -1 row:

LastRow = cell.row - 1

 

[kevin9999]

Happy to have helped & thanks for the feedback