Greetings Jacob!
I am impressed. You really know Excel VBA! Thanks a million for your help.
With the following code, I was able to revert back to using the InputBox
Function without generating an error on cancel:

Dim varPrice As Variant
varPrice = InputBox(Prompt:=NoPricesFoundMsg, _
Title:="Select Price", Default:=CurrentPrice, XPos:=4900, YPos:=500)
If Trim(varPrice) < "" And IsNumeric(Trim(varPrice)) _
Then SelectPrice = CDbl(varPrice)

varPrice = InputBox(Prompt:=PricesFoundMsg, _
Title:="Select Price", Default:=DefaultPrice, XPos:=4900, YPos:=500)
If Trim(varPrice) < "" And IsNumeric(Trim(varPrice)) _
Then SelectPrice = CDbl(varPrice)

And further, I was able to position the Dialog Box in a nice convenient way
(Using XPos and YPos). Perhaps some day Microsoft will get the InputBox
Method responding properly to Left and Top.
--
May you have a most blessed day!

Sincerely,

Michael Fitzpatrick


"Jacob Skaria" wrote:

Hi Michael

App.InputBox works for me..OK..If InputBox works for you let us work on
that. In th e below code the input is passed to a variable declared as a
Variant and then validated and passed on to the actual variable. Does that
work ?.

Dim varPrice As Variant
varPrice = InputBox(Prompt:=NoPricesFoundMsg, _
Title:="Select Price", Default:=currentprice)
If Trim(varPrice) < "" And IsNumeric(Trim(varPrice)) _
Then SelectPrice = CDbl(varPrice)

If this post helps click Yes
---------------
Jacob Skaria


"MichaelDavid" wrote:

Greetings Jacob! Here is my full code. Originally I was using the InputBox
Function which is very similar to the Input Box Method. The code is now fully
debugged except for inability to display the Dialog Box near top left corner.

Option Explicit

Sub FindAndCorrectFirstNextInvalidPrice()

' Keyboard Shortcut: Ctrl+l

Dim ActvCellRow As Long
Dim ActvCellCol As Long
Dim LstRowData As Long
Dim ActvCellContents As Date
Dim SvdActvCellContents As Date
Dim DateMinusTwo As Date
Dim DateMinusOne As Date
Dim DatePlusOne As Date
Dim DatePlusTwo As Date
Dim SameDate As Date
Dim MessageDateP1 As String
Dim MessageDateP2 As String
Dim MessageDateM1 As String
Dim MessageDateM2 As String
Dim MessageSameDate As String

Dim rngToSearch As Range
Dim rngToFindM2 As Range
Dim rngToFindM1 As Range
Dim rngToFindSD As Range
Dim rngToFindP1 As Range
Dim rngToFindP2 As Range

Dim ACA As Variant
Dim SvdActvCellRow As Long
Dim SvdActvCellCol As Long
Dim DateOK As Boolean
Dim SelectPrice As Double
Dim PricesFoundMsg As String
Dim NoPricesFoundMsg As String
Dim DefaultPrice As Double
Dim CurrentPrice As Double
Dim SvdPrice As Double

With ActiveSheet
LstRowData = .Range("O2")
.Range("M8:M" & LstRowData).UnMerge
.Range("M8:M" & LstRowData).Select
End With

' Set the search criteria for the interior of the cell format.
Application.FindFormat.Interior.Color = vbYellow

' On Error Resume Next
On Error GoTo ErrorExit
Selection.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=True).Activate
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''
ACA = Application.ActiveCell.Address
ActvCellRow = Application.ActiveCell.Row
ActvCellCol = Application.ActiveCell.Column

Cells(ActvCellRow, ActvCellCol - 5).Select

DateOK = IsDate(ActiveCell.Value)
If Not DateOK Then
MsgBox "Invalid Date! Please try again"
Range(ACA).Select
Exit Sub
End If

ActvCellRow = Application.ActiveCell.Row
ActvCellCol = Application.ActiveCell.Column

ActvCellContents = Application.ActiveCell.Value
SvdActvCellContents = ActvCellContents
SvdActvCellRow = ActvCellRow
SvdActvCellCol = ActvCellCol

Cells(ActvCellRow, ActvCellCol) = #1/1/1900#
DateMinusTwo = ActvCellContents - 2
DateMinusOne = ActvCellContents - 1
SameDate = ActvCellContents
DatePlusOne = ActvCellContents + 1
DatePlusTwo = ActvCellContents + 2

LstRowData = Range("O2")

Range("H8:H" & LstRowData).UnMerge

With ActiveSheet
Set rngToSearch = .Range("H8:H" & LstRowData)
End With

CheckDateM2:

Set rngToFindM2 = rngToSearch _
.Find(What:=DateMinusTwo, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)

If rngToFindM2 Is Nothing Then
MessageDateM2 = ""
Else
MessageDateM2 = "On Row " & rngToFindM2.Row & ", Date-2 = " &
rngToFindM2.Value & "; Price = " & Cells(rngToFindM2.Row, rngToFindM2.Column
+ 5)
DefaultPrice = Cells(rngToFindM2.Row, rngToFindM2.Column + 5)
End If

CheckDateP2:

Set rngToFindP2 = rngToSearch _
.Find(What:=DatePlusTwo, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)

If rngToFindP2 Is Nothing Then
MessageDateP2 = ""
Else
MessageDateP2 = "On Row " & rngToFindP2.Row & ", Date+2 = " &
rngToFindP2.Value & "; Price = " & Cells(rngToFindP2.Row, rngToFindP2.Column
+ 5)
If DefaultPrice = 0# Then
DefaultPrice = Cells(rngToFindP2.Row, rngToFindP2.Column + 5)
Else ' Average the DefaultPrice for Date+2 with the DefaultPrice for
Date+1
DefaultPrice = 0.5 * (DefaultPrice + Cells(rngToFindP2.Row,
rngToFindP2.Column + 5))
End If
End If

CheckDateM1:

Set rngToFindM1 = rngToSearch _
.Find(What:=DateMinusOne, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)

If rngToFindM1 Is Nothing Then
MessageDateM1 = ""
Else
MessageDateM1 = "On Row " & rngToFindM1.Row & ", Date-1 = " &
rngToFindM1.Value & "; Price = " & Cells(rngToFindM1.Row, rngToFindM1.Column
+ 5)
DefaultPrice = Cells(rngToFindM1.Row, rngToFindM1.Column + 5)
End If

CheckDateP1:

Set rngToFindP1 = rngToSearch _
.Find(What:=DatePlusOne, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)

If rngToFindP1 Is Nothing Then
MessageDateP1 = ""
Else
MessageDateP1 = "On Row " & rngToFindP1.Row & ", Date+1 = " &
rngToFindP1.Value & "; Price = " & Cells(rngToFindP1.Row, rngToFindP1.Column
+ 5)
If DefaultPrice = 0# Then
DefaultPrice = Cells(rngToFindP1.Row, rngToFindP1.Column + 5)
Else ' Average the DefaultPrice for Date+2 with the DefaultPrice for
Date+1
DefaultPrice = 0.5 * (DefaultPrice + Cells(rngToFindP1.Row,
rngToFindP1.Column + 5))
End If
End If

CheckSameDate:

Set rngToFindSD = rngToSearch _
.Find(What:=SameDate, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)

If rngToFindSD Is Nothing Then
MessageSameDate = ""
Else
MessageSameDate = "On Row " & rngToFindSD.Row & ", Date+0 = " &
rngToFindSD.Value & "; Price = " & Cells(rngToFindSD.Row, rngToFindSD.Column
+ 5)
DefaultPrice = Cells(rngToFindSD.Row, rngToFindSD.Column + 5)
End If

' Restore Active Cell:
Cells(SvdActvCellRow, SvdActvCellCol) = SvdActvCellContents
Range(ACA).Select

If MessageDateM2 = "" And MessageDateM1 = "" And MessageSameDate = "" And
MessageDateP1 = "" And MessageDateP2 = "" Then
CurrentPrice = Range("H4")
NoPricesFoundMsg = "No date found within 2 days of this date" & vbCrLf &
vbCrLf & _
"Enter desired price (Default is Current Price)"
' SelectPrice = Application.InputBox(Prompt:=NoPricesFoundMsg,
Title:="Select Price", Default:=CurrentPrice, Left:=-10000000,
Top:=-10000000, Type:=1)
SelectPrice = Application.InputBox(Prompt:=NoPricesFoundMsg, _
Title:="Select Price", Default:=CurrentPrice, Left:=ActiveCell.Left, _
Top:=ActiveCell.Top, Type:=1)
If SelectPrice = False Then
Exit Sub
End If
Range(ACA).Select
Application.ActiveCell = SelectPrice
Else
PricesFoundMsg = MessageDateM2 & vbCrLf & _
MessageDateM1 & vbCrLf & _
MessageSameDate & vbCrLf & _
MessageDateP1 & vbCrLf & _
MessageDateP2 & vbCrLf & vbCrLf & _
"Enter desired price"

' SelectPrice = Application.InputBox(Prompt:=PricesFoundMsg,
Title:="Select Price", Default:=DefaultPrice, Left:=-10000000,
Top:=-10000000, Type:=1)
SelectPrice = Application.InputBox(Prompt:=PricesFoundMsg, _
Title:="Select Price", Default:=DefaultPrice, Left:=ActiveCell.Left, _
Top:=ActiveCell.Top, Type:=1)
If SelectPrice = False Then
Exit Sub
End If
Range(ACA).Select
SvdPrice = Application.ActiveCell.Value
Application.ActiveCell = SelectPrice
End If
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''
ActiveCell.Interior.Color = vbGreen
ActvCellRow = Application.ActiveCell.Row
ActvCellCol = Application.ActiveCell.Column
Cells(ActvCellRow, ActvCellCol + 1).Interior.Color = vbYellow
Cells(ActvCellRow, ActvCellCol + 1) = " Was " & SvdPrice
Exit Sub

ErrorExit:
MsgBox "No more Invalid Prices Found"
Range("W" & LstRowData + 9).Select
End Sub



--
May you have a most blessed day!

Sincerely,

Michael Fitzpatrick


"Jacob Skaria" wrote:

1. Check whether the below is working which will display the dialog near to
the active cell..

SelectPrice = Application.InputBox(Prompt:=PricesFoundMsg, _
Title:="Select Price", Default:=DefaultPrice, Left:=ActiveCell.Left, _