ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   VBA Excel: Problem w/ Loop (https://www.excelbanter.com/excel-programming/339656-vba-excel-problem-w-loop.html)

[email protected]

VBA Excel: Problem w/ Loop
 
Hi,


I am trying write an excel macro that will prompt the user to choose a
number between 1 & 128, beginning from 64 the user will choose whether
or not the number they have chosen is higher or lower until the number
is selected.


However, I would like to write an exception statement (error statement)

where the vba interpreter prints an error message if the user's chosen
number is inconsistent in other words the person is dishonest about
their guess. This should happen in less than 7 guesses or less.


But I cannot get it to work. Please instruct me on how best to rewrite
this script.


Code:
------------------------------*----------------------
Sub Guess()
Worksheets("Sheet1").Range("A1*:IV65536").ClearFor mats
Worksheets("Sheet1").Range("A1*:IV65536").ClearCon tents
Columns("A:IV").ColumnWidth = 10
Dim Hi As Integer
Dim Lo As Integer
Dim Guess As Integer
Dim NoGuess As Integer
Dim Ans As String
Hi = 128
Lo = 1
NoGuess = 0
Ans = ""
Resp = MsgBox("Pick a number from 1 to 128 and click on OK when you
have it", vbOKOnly)


Do Until (NoGuess = 8)
NoGuess = NoGuess + 1
Guess = (Hi + Lo) / 2
Range("A1").Value = "My Guess: Number "
Range("B1").Value = NoGuess
Range("C1").Value = " is "
Range("D1").Value = Guess
Ans = InputBox("Please Enter hi, lo or eq", "Hi", "eq")
If Ans = "hi" Then Hi = Guess - 1
If Ans = "lo" Then Lo = Guess + 1
If NoGuess = 8 Then
Range("A2").Text = "Error: Your guess must remain constant until end!"
Columns("A:E").AutoFit
Loop
End Sub
------------------------------*--------------------------


Hakim Singhji
New York University

BTW: cross posted to vba/excel


Jim Cone

VBA Excel: Problem w/ Loop
 
Hakim,
I redid the whole thing...
Jim Cone
San Francisco, USA

'-------------------------
Sub GuessTheNumber()
On Error GoTo BadGuess
Dim Hi As Integer
Dim Lo As Integer
Dim Guess As Integer
Dim NoGuess As Integer
Dim Ans As String

If MsgBox("Pick a number from 1 to 128 then click OK." & vbTab, _
vbOKCancel, " Guess Number") = vbCancel Then Exit Sub
Hi = 128
Lo = 1
NoGuess = 0

Worksheets("Guess Sheet").UsedRange.Clear
Do Until (NoGuess = 8)
NoGuess = NoGuess + 1
Guess = (Hi + Lo) / 2
Ans = InputBox("Please Enter high (h), low (l) or equal (e)", _
" Is Your Guess Higher or Lower ?", Guess)
'User clicks Cancel.
If Len(Ans) = 0 Then
Exit Do
ElseIf Left$(Ans, 1) = "h" Then
Lo = Guess
ElseIf Left$(Ans, 1) = "l" Then
Hi = Guess
ElseIf Left$(Ans, 1) = "e" Then
Range("A1").Value = "YOUR NUMBER"
Range("A2").Value = Guess
Columns("A").AutoFit
MsgBox "Your guess was " & Guess & vbTab, vbInformation, " Thank You"
Exit Do
End If
If NoGuess = 8 Then
MsgBox "You are not playing fair!" & vbTab, vbExclamation, " Guess Number"
Exit Do
End If
Loop
Exit Sub

BadGuess:
Beep
End Sub
'----------------------------




wrote in message
ups.com
Hi,
I am trying write an excel macro that will prompt the user to choose a
number between 1 & 128, beginning from 64 the user will choose whether
or not the number they have chosen is higher or lower until the number
is selected.
However, I would like to write an exception statement (error statement)
where the vba interpreter prints an error message if the user's chosen
number is inconsistent in other words the person is dishonest about
their guess. This should happen in less than 7 guesses or less.
But I cannot get it to work.
Please instruct me on how best to rewrite this script.
Code:
------------------------------*----------------------
Sub Guess()
Worksheets("Sheet1").Range("A1*:IV65536").ClearFor mats
Worksheets("Sheet1").Range("A1*:IV65536").ClearCon tents
Columns("A:IV").ColumnWidth = 10
Dim Hi As Integer
Dim Lo As Integer
Dim Guess As Integer
Dim NoGuess As Integer
Dim Ans As String
Hi = 128
Lo = 1
NoGuess = 0
Ans = ""
Resp = MsgBox("Pick a number from 1 to 128 and click on OK when you
have it", vbOKOnly)
Do Until (NoGuess = 8)
NoGuess = NoGuess + 1
Guess = (Hi + Lo) / 2
Range("A1").Value = "My Guess: Number "
Range("B1").Value = NoGuess
Range("C1").Value = " is "
Range("D1").Value = Guess
Ans = InputBox("Please Enter hi, lo or eq", "Hi", "eq")
If Ans = "hi" Then Hi = Guess - 1
If Ans = "lo" Then Lo = Guess + 1
If NoGuess = 8 Then
Range("A2").Text = "Error: Your guess must remain constant until end!"
Columns("A:E").AutoFit
Loop
End Sub
Hakim Singhji
New York University
BTW: cross posted to vba/excel



All times are GMT +1. The time now is 05:05 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com