LBPLC
LBPLC

Reputation: 1571

VBA - Set Range Between Two Dates Using Search Function

I'm trying to get my VBA code to search through a column for a user-inputted value (on a form) and set a range based on the values.

I need the code to scan DOWN through the column until it finds the value (which is a date) and then scan UP through the column to get the second part of the range. I need it to be like this because there might be multiple instances of the same date and they all need to be accounted for.

I've tried this:

StartRange = ws.Cells.Find(What:=StartDate, SearchOrder:=xlRows, _
    SearchDirection:=xlNext, LookIn:=xlValues)

EndRange = ws.Cells.Find(What:=EndDate, SearchOrder:=xlRows, _
    SearchDirection:=xlPrevious, LookIn:=xlValues)

But it's not working the way I had expected and is erroring. (Edit: the WS has been defined, so I know that's not the issue). I don't even know if I'm going about this the right way

I'm feeling defeated :(

Any help would be appreciated, Thanks in advance!

Edit:

I've yet to try any of the suggestions as I am away from my project at the moment, but I feel I need to clarify a few things.

  1. The dates will always be in chronological order, I have a script that organises them on sheet activation

  2. I need to be able to error handle dates that do not appear in the database, I also need the script to be able to "skip over" dates that don't exist. Ie, 1st 1st 1st, 3rd, 3rd, 5th. If my start and end dates were the 1st and 5th, the entire example would be the range.

Thanks for your help so far guys though, I appreciate it!

EDIT2:

I've tried a few answers and have added this in to my code, but it is now failing on a Range_Global fail.

Dim startrange, endrange, searchrange As Range
LookUpColumn = 2

With ws.Columns(LookUpColumn)
    Set startrange = .Find(What:=Me.R_Start.Value, _
      After:=ws.Cells(.Rows.count, LookUpColumn), _
      SearchOrder:=xlRows, _
      SearchDirection:=xlNext, LookIn:=xlValues)

    Set endrange = .Find(What:=Me.R_End.Value, _
      After:=ws.Cells(5, LookUpColumn), _
      SearchOrder:=xlRows, _
      SearchDirection:=xlPrevious, LookIn:=xlValues)

    searchrange = Range(startrange, endrange)

MsgBox searchrange.Address
End With

Any suggestions?

Upvotes: 0

Views: 14397

Answers (3)

chris neilsen
chris neilsen

Reputation: 53136

Using Find is the right way to do this type of thing, you just need to get a few details right.

  • Use Set to assign range references. Eg Set StartRange = ... (and make sure to Dim StartRange as Range). Ditto EndRange and SearchRange

  • Specify a After cell. Note that by default this is the Top Left cell of the search range, and the search begins after this cell. If your StartDate happens to be in cell A1 (and another cell) then leaving as default will return the wrong result

  • Limit the search range to the column of interest.

  • Dim all your variables. Each variaqble needs its own As (and use Option Explicit)

End result

Dim startrange As Range, endrange As Range, searchrange As Range
Dim LookUpColumn as Long

LookUpColumn = 2
With ws.Columns(LookupColumn)
    ' Make sure lookup column data is type Date
    Set searchrange = .SpecialCells(xlCellTypeConstants)
    searchrange.Value = searchrange .Value
    Set searchrange = Nothing

    Set StartRange = .Find(What:=CDate(StartDate), _
      After:=.Cells(.Rows.Count, LookupColumn), _
      SearchOrder:=xlRows, _
      SearchDirection:=xlNext, LookIn:=xlValues)

    Set EndRange = .Find(What:=CDate(EndDate), _
      After:=.Cells(1, LookupColumn), _
      SearchOrder:=xlRows, _
      SearchDirection:=xlPrevious, LookIn:=xlValues)
End With

Set searchrange = Range(startrange, endrange)
MsgBox searchrange.Address

Upvotes: 2

Sam
Sam

Reputation: 7303

I don't like the concept of this date search for a couple of reasons..

  • It makes the assumption that the dates will always be in order
  • It makes the assumption that both the dates will exist in the list

Whilst these may be valid assumptions in this case, I'm sure there may be instances where this may not be the case...

I don't know the best way to do this but one alternative to consider is using the auto-filter

Something like:

 Sub FindDateRange()

Dim sht As Worksheet
Dim column As Long
Set sht = Sheet1

Dim rng As Range, inclusiveRange As Range
Dim startDate As Long, endDate As Long

column = 2

On Error GoTo Err

startDate = DateValue("02/10/2012")
endDate = DateValue("05/10/2012")

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False


    sht.Cells(1, column).AutoFilter Field:=column, Criteria1:=">=" & startDate, Operator:=xlAnd _
            , Criteria2:="<=" & endDate


    Set rng = sht.Range(sht.Cells(2, column), sht.Cells(sht.Cells(sht.Rows.Count, column).End(xlUp).Row, column)).SpecialCells(xlCellTypeVisible)

    sht.AutoFilterMode = False

    If rng.Address = sht.Cells(1, column).Address Then



        MsgBox Format(startDate, "dd-mmm-yyyy") & " - " & Format(endDate, "dd-mmm-yyyy") _
        & vbCrLf & vbCrLf & "No instances of the date range exist"

    Else

    Set inclusiveRange = sht.Range(rng.Cells(1, 1), rng.Cells(rng.Count, 1))

        MsgBox Format(startDate, "dd-mmm-yyyy") & " - " & Format(endDate, "dd-mmm-yyyy") _
        & vbCrLf & vbCrLf & "the range is " & rng.Address & vbCrLf & vbCrLf & _
        "inclusive range is " & inclusiveRange.Address
    End If





continue:

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

Exit Sub

Err:
    MsgBox Err.Description
    GoTo continue


End Sub

Example2

Example1

Example3

Upvotes: 1

Takedasama
Takedasama

Reputation: 387

Let's start with this and see what needs to be fine tuned. This code will look for a date (based on input) and find the position of that date in a column. Same with the "EndDate" and then creates a range on that column between the 2 positions.

Sub ARange()
Dim Sh As Worksheet: Set Sh = Sheets("Sheet1")
Dim i, j As Integer

LookupColumn = "A" 'Define the LookupColum / If you find using column index to be simpler then you need to switch the search from (range) to (cells)
StartDate_Value = Sh.Range("B2").Value 'Use whatever you need to define the input values
EndDate_Value = Sh.Range("C2").Value 'Use whatever you need to define the input values

For i = 1 To 30000
    If Sh.Range(LookupColumn & i).Value = EndDate_Value Then EndDate_Row = i
Next i

For j = EndDate_Row To 1 Step -1
    If Sh.Range(LookupColumn & j).Value = StartDate_Value Then StartDate_Row = j
Next j

Dim MyDateRange As Range: Set MyDateRange = Sh.Range(LookupColumn & StartDate_Row & ":" & LookupColumn & EndDate_Row)
MsgBox "MyDateRange = " & LookupColumn & StartDate_Row & ":" & LookupColumn & EndDate_Row
End Sub

Another approach should imply looking for the EndDate from bottom upwards (as in Excel's column values) and for the StartDate from top to bottom. like this:

For i = 30000 to 1 step -1
For j = 1 To 30000

And the 3rd (the charm):for the EndDate from top to bottom and for the StartDate from top to bottom. like this:

For i = 1 to 30000
For j = 1 To 30000

And the 4th (The One):

For i = 1 to 30000
For j = 30000 to 1 Step -1

On my home laptop the search on the 30.000 cells is instant (under 1s). Give it a try and based on the feedback we can fine tune it.

On the Other hand, I might read your question as for looking To select not all values between the top / bottom position, but any cells with values of dates between the 2 input values neverminind the arrangement of the values within the list (column cells). i.e. If StartDate = 1.Jan.2013 and EndDate = 3.Jan.2013. The code should pick up 1,2 and 3 from the 30.000 list neverminind the position of these 3 dates (which in fact may be found thousands of times). If This is true, the solution may be simpler than the one above.

Upvotes: 1

Related Questions