Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Unable to specify position of InputBox Method Dialog Box on the sc
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Unable to specify position of InputBox Method Dialog Box on the sc
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 --------------- Jacob Skaria "MichaelDavid" wrote: 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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Unable to specify position of InputBox Method Dialog Box on th
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 "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, _ 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 --------------- Jacob Skaria "MichaelDavid" wrote: 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 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Unable to specify position of InputBox Method Dialog Box on th
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, _ 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 --------------- Jacob Skaria "MichaelDavid" wrote: 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 |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Unable to specify position of InputBox Method Dialog Box on th
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, _ 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 --------------- Jacob Skaria "MichaelDavid" wrote: 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 & _ |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Unable to specify position of InputBox Method Dialog Box on th
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, _ |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Application.InputBox screen position doesn't work. | Excel Programming | |||
InputBox method with range | Excel Programming | |||
position of inputbox | Excel Programming | |||
InputBox Screen Position | Excel Programming | |||
Error 424 with inputbox method after OK | Excel Programming |