Find Date or Close to it

[Joseph]

The deal is this.

Find date
if date is""
find closest < target.

If looking for 2/5/2011, and it does not exist, then show me 02/04/2011. Rather than the vbex., if possible.

Code: Select all

 Set rngFound = ws.Columns("A:A").Find(DateValue(Me.dateto.Text))
  If rngFound Is Nothing Then
    MsgBox "Date not found!", vbExclamation
    Exit Sub
  End If
  irow = rngFound.Row

[HansV]

The following assumes that column A contains dates in ascending order.

irow = Application.WorksheetFunction.Match(CDate(Me.dateto.Text), ws.Range("A:A"))

[Joseph]

I am getting an error:
"Unable to get the Match property of the WorksheetFunction class"

[HansV]

Please attach a copy of the workbook.

[Joseph]

Here you are sir.

I have identical code in the List_sites listbox and Command Button on UserForm1.

I actually surprised myself with some of the things I did get to work, without help. (Though not much).

Uh Oh...I didn't check all the code for formatting, so I'm sure I'll catch a beating on that.

[HansV]

Thanks. Try this slight modification:

Code: Select all

  irow = Application.WorksheetFunction.Match(CLng(CDate(Me.dateto.Text)), ws.Range("A:A"))

[Joseph]

Ok, that works, thanks.

Problem though is this. If my (dateFrom) is a Monday and (dateto) is a Saturday, and there is no record for (dateTo), it shows me Friday which is perfect. However because the number of days (nod.text) is 6 this formula will then sum from (Sunday to Friday) where it needs to still sum from (Monday to Friday)

So my question is. How can I change this formula, to instead of using (-nod.value) as a starting point. Use the (FromDate).

Code: Select all

Dbtarget = Application.WorksheetFunction.Sum(target.Offset(-nod.value).Resize(nod.value + 1))

Code: Select all

 strSiteID = Me.site1.Text
 On Error Resume Next
 Set ws = Worksheets("" & strSiteID & "")
 On Error GoTo 0
 ws.Activate
'********Gross Revenue
'Find date value or close to it in selected sheet

  irow = Application.WorksheetFunction.Match(CLng(CDate(Me.dateto.Text)), ws.Range("A:A"))
  
'Find Metric value in selected sheet

  Set rng = ws.Rows(1).Find(Me.met1.Text)
  If rng Is Nothing Then
    MsgBox "Metric not found!", vbExclamation
    Exit Sub
  End If
  icol = rng.Column
  Dim target As Range
  Set target = ws.Cells(irow, icol)
  
'Determine Dashboard Target and insert value from site sheet target

 Set Db = Worksheets("Dashboard")
 Db.Activate

'Find site in dashboard
  
  Set rngFound = Db.Columns("A:A").Find(Me.site1.Text)
  If rngFound Is Nothing Then
    MsgBox "Site not found!", vbExclamation
    Exit Sub
  End If
  irow = rngFound.Row
  
'Find Metric value in dashboard

  Set rng = Db.Rows(5).Find(Me.met1.Text)
  If rng Is Nothing Then
    MsgBox "Metric not found!", vbExclamation
    Exit Sub
  End If
  icol = rng.Column
  Dim Dbtarget As Range
  Set Dbtarget = Db.Cells(irow, icol)
  
Dbtarget = Application.WorksheetFunction.Sum(target.Offset(-nod.value).Resize(nod.value + 1))

I hope this isn't too confusing...

[HansV]

You could set the value of dateTo to the found closest date. This will call the dateTo_Change event procedure and update nod.

But it's possible that this will change dateTo to a date before dateFrom, causing nod to become negative. What do you want to do then? One solution would be to search for the nearest date on or before dateFrom too.

[Joseph]

I think a variation of this:"One solution would be to search for the nearest date on or before dateFrom too." would work best.

So...my guess.

ifrom = Application.WorksheetFunction.Match(CLng(CDate(Me.datefrom.Text)), ws.Range("A:A"))
ito = Application.WorksheetFunction.Match(CLng(CDate(Me.dateto.Text)), ws.Range("A:A"))
irow = ws.range (ifrom, ito).row

Does that seem right, with essentially 2 row references?

If some variation like this will work, I will not need the nod.text.

[HansV]

That last line won't work. I think you'll have to set dateFrom to ws.Range("A" & ifrom) and dateTo to ws.Range("A" & ito).

[Joseph]

Something like this? I get an object defined error on line 3.

Code: Select all

 
 Dim ito As Range
 Dim ifrom As Range
 Set ito = ws.Range("A" & ifrom)
 Set ifrom = ws.Range("A" & ito)
  ito = Application.WorksheetFunction.Match(CLng(CDate(Me.dateto.Text)), ws.Range("A:A"))
  ifrom = Application.WorksheetFunction.Match(CLng(CDate(Me.datefrom.Text)), ws.Range("A:A"))
  irow = ws.Range(ito & ifrom)

I tried this way and got a Match error:

Code: Select all

 Dim ito As Range
 Dim ifrom As Range
  Set ito = Application.WorksheetFunction.Match(CLng(CDate(Me.dateto.Text)), ws.Range("A" & ifrom))
  Set ifrom = Application.WorksheetFunction.Match(CLng(CDate(Me.datefrom.Text)), ws.Range("A" & ito))
  irow = ws.Range(ito & ifrom)

This way seems to make the most sense, but I get an object error on line 6:

Code: Select all

 Dim ito As Range
 Dim ifrom As Range
 ito = Application.WorksheetFunction.Match(CLng(CDate(Me.dateto.Text)), ws.Range("A:A"))
 ifrom = Application.WorksheetFunction.Match(CLng(CDate(Me.datefrom.Text)), ws.Range("A:A"))
  ito = ws.Range("A" & ifrom)
  ifrom = ws.Range("A" & ito)
  irow = ws.Range(ito & ifrom)

[HansV]

Neither of those makes sense - you're mixing range objects and row numbers as if they're the same.
Try

ifrom = Application.WorksheetFunction.Match(CLng(CDate(Me.datefrom.Text)), ws.Range("A:A"))
irow = Application.WorksheetFunction.Match(CLng(CDate(Me.dateto.Text)), ws.Range("A:A"))
Me.dateFrom = ws.Range("A" & ifrom)
Me.dateTo = ws.Range("A" & irow)

[Joseph]

This seems like it's going to work. But now I'm stumbling on getting the formula to work...

Code: Select all

Dbtarget = Application.WorksheetFunction.Sum(target.Offset(Me.datefrom.value).Resize(Me.dateto.value))

Code: Select all

Dim ifrom As Long

 ifrom = Application.WorksheetFunction.Match(CLng(CDate(Me.datefrom.Text)), ws.Range("A:A"))
 irow = Application.WorksheetFunction.Match(CLng(CDate(Me.dateto.Text)), ws.Range("A:A"))
 Me.datefrom = ws.Range("A" & ifrom)
 Me.dateto = ws.Range("A" & irow)


'Find Metric value in selected sheet

  Set rng = ws.Rows(1).Find(Me.met1.Text)
  If rng Is Nothing Then
    MsgBox "Metric not found!", vbExclamation
    Exit Sub
  End If
  icol = rng.Column
  Dim target As Range
  Set target = ws.Cells(irow, icol)
  
'Determine Dashboard Target and insert value from site sheet target

 Set Db = Worksheets("Dashboard")
 Db.Activate

'Find site in dashboard
  
  Set rngFound = Db.Columns("A:A").Find(Me.site1.Text)
  If rngFound Is Nothing Then
    MsgBox "Site not found!", vbExclamation
    Exit Sub
  End If
  irow = rngFound.Row
  
'Find Metric value in dashboard

  Set rng = Db.Rows(5).Find(Me.met1.Text)
  If rng Is Nothing Then
    MsgBox "Metric not found!", vbExclamation
    Exit Sub
  End If
  icol = rng.Column
  Dim Dbtarget As Range
  Set Dbtarget = Db.Cells(irow, icol)
  
Dbtarget = Application.WorksheetFunction.Sum(target.Offset(Me.datefrom.value).Resize(Me.dateto.value))

[HansV]

That makes no sense again. Can you explain in words what your intention is?

[Joseph]

I want to sum the found metric (target), between the datefrom and dateto rows.

[HansV]

Set target as follows:

Code: Select all

  Dim target As Range
  Set target = ws.Range(ws.Cells(ifrom, icol), ws.Cells(irow, icol))

You can then simply use

Dbtarget = Application.WorksheetFunction.Sum(target)

[Joseph]

That's it, thanks Hans!!!