Unable to specify position of InputBox Method Dialog Box on the sc

[MichaelDavid]

Greetings! I tried to position the InputBox Method Dialog Box on the screen
by varying the values of Left and Top in its parameter list. No matter what
values I select for Left and Top, the Input Box Method's Dialog Box displays
in the middle of the screen about a third of the way down. (I tried values
ranging from 0 to 5000, and also negative numbers and real numbers as well.)
Otherwise the InputBox Method works perfectly. The code is as follows:

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:=1, Top:=1, Type:=1)

The corresponding Input Box Function which uses XPos and YPos instead of
Left and Top works perfectly. One is able to position the dialog box anywhere
on the screen by varying XPos and YPos. But due to the way a cancel is
handled by the Input Box Function, I have to use the Input Box Method. All
suggestions and workarounds will be greatly appreciated. Thanks!
--
May you have a most blessed day!

Sincerely,

Michael Fitzpatrick
--
May you have a most blessed day!

Sincerely,

Michael Fitzpatrick

 

[Jacob Skaria]

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, _
Top:=ActiveCell.Top, Type:=1)

2. Could you post the issue you have with InputBox cancel ...(with existing
code)

If this post helps click Yes

 

[MichaelDavid]

Hi Jacob:
I tried your suggestion, but the Dialog Box's position did not budge. I
am beginning to suspect that this is a "feature" that Microsoft has not yet
designed a fix for. I scoured the Internet, and none of the web sites
discusses the Left and Top parameters.
As reported by several web sites, the problem with the InputBox Function
is that Cancel generates an error which must be handled. Since my code is
already using an OnError GoTo to handle another error, that is what is also
handling the Cancel error (but in an unsatisfactory and unintended way in my
code.) That is why I switched to the InputBox Method.
--
May you have a most blessed day!

Sincerely,

Michael Fitzpatrick

 

[MichaelDavid]

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]

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

 

[MichaelDavid]

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