'=========================================================
'==            Visual Basic Sample Code From            ==
'==     Microsoft Excel/Visual Basic for Windows 95     ==
'==                  Programmer's Guide                 ==
'==                      Chapter 3                      ==
'=========================================================

' DISCLAIMER OF WARRANTY

' THIS FILE CONTAINS UNDOCUMENTED SAMPLE CODE. THIS SAMPLE CODE IS 
' PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND. MICROSOFT FURTHER
' DISCLAIMS ALL IMPLIED WARRANTIES INCLUDING WITHOUT LIMITATION ANY
' IMPLIED WARRANTIES OF MERCHANTABILITY OR OF FITNESS FOR A PARTICULAR
' PURPOSE. THE ENTIRE RISK ARISING OUT OF THE USE OR PERFORMANCE OF THE
' SAMPLE CODE REMAINS WITH YOU.

' IN NO EVENT SHALL MICROSOFT OR ITS SUPPLIERS BE LIABLE FOR ANY DAMAGES
' WHATSOEVER (INCLUDING, WITHOUT LIMITATION, DAMAGES FOR LOSS OF
' BUSINESS PROFITS, BUSINESS INTERRUPTION, LOSS OF BUSINESS INFORMATION,
' OR OTHER PECUNIARY LOSS) ARISING OUT OF THE USE OF OR INABILITY TO USE
' THIS SAMPLE CODE, EVEN IF MICROSOFT HAS BEEN ADVISED OF THE POSSIBILITY
' OF SUCH DAMAGES. BECAUSE SOME STATES DO NOT ALLOW THE EXCLUSION OR
' LIMITATION OF LIABILITY FOR CONSEQUENTIAL OR INCIDENTAL DAMAGES, THE
' ABOVE LIMITATION MAY NOT APPLY TO YOU.






'=========================================================
'==                    From Page 52                     ==
'=========================================================

If thisVal < 0 Then thisVal = 0

If thisVal > 5 Then
	thatVal = thisVal + 25
	thisVal = 0
End If





'=========================================================
'==                    From Page 53                     ==
'=========================================================

If age < 16 Then
	MsgBox "You are not old enough for a license."
Else
	MsgBox "You can be tested for a license."
End If

'-------------------------------------------------

Function Bonus(jobClass, salary, rating)
	If jobClass = 1 Then
		Bonus = salary * 0.1 * rating / 10
	ElseIf jobClass = 2 Then
		Bonus = salary * 0.09 * rating / 10
	ElseIf jobClass = 3 Then
		Bonus = salary * 0.07 * rating / 10
	Else
		Bonus = 0
	End If
End Function





'=========================================================
'==                    From Page 54                     ==
'=========================================================

Function Bonus(jobClass, salary, rating)
	Select Case jobClass
		Case 1
			Bonus = salary * 0.1 * rating / 10
		Case 2
			Bonus = salary * 0.09 * rating / 10
		Case 3
			Bonus = salary * 0.07 * rating / 10
		Case 4, 5	'The expression list can contain several values...
			Bonus = salary * 0.05 * rating / 5
		Case 6 To 8	'...or be a range of values
			Bonus = 150
		Case Is > 8	'...or be compared to other values
			Bonus = 100
		Case Else
			Bonus = 0
	End Select
End Function





'=========================================================
'==                    From Page 55                     ==
'=========================================================

Function CountStrings(longstring, target)
	position = 1
	Do While InStr(position, longstring, target) 'Returns True/False
		position = InStr(position, longstring, target) + 1
		Count = Count + 1
	Loop
	CountStrings = Count
End Function





'=========================================================
'==                    From Page 56                     ==
'=========================================================

Response = MsgBox("Do you want to process more data?", vbYesNo)
Do Until Response = vbNo
	ProcessUserData	'Call procedure to process data
	Response = MsgBox("Do you want to process more data?", vbYesNo)
Loop

'-------------------------------------------------

Sub MakeBlue()
	Set rSearch = Worksheets("sheet1").Range("a1:a10")
	Set c = rSearch.Find("test")
	If Not c Is Nothing Then
		first = c.Address
		Do
			c.Font.ColorIndex = 5
			Set c = rSearch.FindNext(c)
		Loop While (Not c Is Nothing) And (c.Address <> first)
	Else
		MsgBox "not found"
	End If
End Sub





'=========================================================
'==                    From Page 57                     ==
'=========================================================

Do
	ProcessUserData	'Call procedure to process data
	response = MsgBox("Do you want to process more data?", vbYesNo)
Loop Until response = vbNo

'-------------------------------------------------

Sub BeepSeveral()
	numBeeps = InputBox("How many beeps?")
	For counter = 1 To numBeeps
		Beep
	Next counter
End Sub

'-------------------------------------------------

Sub ClearArray(ByRef ArrayToClear())
	For i = LBound(ArrayToClear) To UBound(ArrayToClear) Step 2
		ArrayToClear(i) = 0
	Next i
End Sub





'=========================================================
'==                    From Page 58                     ==
'=========================================================

For Each c In Worksheets("sheet3").Range("a1").CurrentRegion.Cells
	If c.Value < -1 Then c.Delete
Next c





'=========================================================
'==                    From Page 59                     ==
'=========================================================

Function CountValues(rangeToSearch, searchValue)
	If TypeName(rangeToSearch) <> "Range" Then
		MsgBox "You can search only a range of cells."
	Else
		For Each c in rangeToSearch.cells
			If c.Value = searchValue Then
				counter = counter + 1
			End If
		Next c
	End If
	CountValues = counter
End Function





'=========================================================
'==                    From Page 60                     ==
'=========================================================

i = LBound(searchArray)
ub = UBound(searchArray)
foundIt = False
Do
	If searchArray(i) = findThis Then foundIt = True
	i = i + 1
Loop While i <= ub And Not foundIt

'-------------------------------------------------

For Each c in rangeToSearch
	If c.Value = searchValue Then
		found = True
		Exit For
	End If
Next

'-------------------------------------------------

For Each c in rangeToSearch
	If c.Value = searchValue Then
		counter = counter + 1
	ElseIf c.Value = "Bad Data" Then
		countValues = Null
		Exit Function	'Stop testing and exit immediately.
	End If
Next c

