VBA to find the range at the intersection of two values.

**Benisato** · 01-31-2013, 03:36 PM

Good Day all,

The problem I'm having today is that I would like a VBA module that will allow me to choose a date, and it will then select the cell that intersects between the two dates that are listed in the rows and columns. I've attached an example worksheet for reference that can explain the problem better.

Thanks for the help.
Chris

**patel45** · 01-31-2013, 05:00 PM

how do you want choose the date ? selecting a cell ?

**Benisato** · 01-31-2013, 05:10 PM

The Date will be in a cell on a different sheet.

**stnkynts** · 01-31-2013, 05:37 PM

Try:

Sub Date_Intersection()
Dim ws As Worksheet:    Set ws = Sheets("Sheet1")
Dim myInput As Variant
Dim myDate As String
Dim iCol As Range, iRow As Range
Dim lastrow As Long, lastcol As Long

lastrow = ws.Range("A" & Rows.Count).End(xlUp).Row
lastcol = ws.Cells(1, Columns.Count).End(xlToLeft).Column

myInput = Application.InputBox("Please enter the date.")

If myInput = "" Then Exit Sub
If myInput = False Then Exit Sub

If IsDate(myInput) Then
    myDate = Format(DateValue(myInput), "d-mmm")
Else
    MsgBox "Please enter a valid date."
    Exit Sub
End If

Set iCol = ws.Range(Cells(1, 1), Cells(1, lastcol)).Find(What:=myDate, LookIn:=xlValues, LookAt:=xlWhole)
If iCol Is Nothing Then
    MsgBox ("The date " & myDate & " could not be found.")
    Exit Sub
End If

Set iRow = ws.Range("A1:A" & lastrow).Find(What:=myDate, LookIn:=xlValues, LookAt:=xlWhole)

If iRow Is Nothing Then
    MsgBox ("The date " & myDate & " could not be found.")
    Exit Sub
End If

ws.Cells(iRow.Row, iCol.Column).Select 'this is where you asked to select it

End Sub

**patel45** · 01-31-2013, 06:10 PM

Sub a()
Dim c As Range, sdate As Date
sdate = Sheets(2).Range("A14").Value
With Sheets(1).UsedRange
  Set c = .Find(what:=sdate, LookIn:=xlFormulas)
  col = c.Column
  Set c = .FindNext(c)
  crow = c.Row
End With
MsgBox Cells(crow, col).Text
End Sub