'This makes Excel a B**ch !
'This ensures all variables must be defined
'(This is performed by a DIM statement)
Option Explicit
Sub myFirstSub()
Dim currentColor As Integer
'This assigns a value to the Excel Cell D7
'The value is the text "Hello World!"
Cells(7, 4) = "Hello World!"
'This assigns a value to the ColorIndex property
'of the Interior property of the Excel Cell D7
'The value is the number 3
' (Sets the background color red)
Cells(7, 4).[Link] = 3
'This assigns a value to the variable currentColor
'The value is the value of the Excel Cell E7
currentColor = Cells(7, 5)
'This assigns a value to the variable currentColor
'The value is the value of the variable
'currentColor + 1
currentColor = currentColor + 3
'This assigns a value to the Excel E7
'The value is the value of the variable currentColor
Cells(7, 5) = currentColor
'This assigns a value to the ColorIndex property of the
'Interior property of the Excell E7.
'The value is the value of the variable currentColor
Cells(7, 5).[Link] = currentColor
End Sub
Sub mySecondSub()
Dim someText As String
Dim Comment As String
'This assigns a value to the variable someText
'The value is the text "King James"
someText = "King James"
'This assigns a value to Excel Cell B10
'The value is the value of the variable someText
Cells(10, 2) = someText
'This assigns a value to the variable someText
'The value is the number 1969
someText = 1969
'This assigns a value to Excel Cell B11
'The value is the value of the variable someText
Cells(11, 2) = someText
'This assigns a value to the variable someText
'The value is the text 1969
someText = "1969"
'This assigns a value to Excel Cell B12
'The value is the value of the variable someText
Cells(12, 2) = someText
'This assigns a value to the variable Comment
'The value is the return value from InputBox,
'entered by the user
Comment = InputBox("Please enter your comment")
'This assigns a value to the Excel cell A1
'The value is the value of the variable Comment
Cells(1, 1) = Comment
'This assigns a value to the Excel cell A2
'The value is the text "Comment"
Cells(2, 1) = "Comment"
'This assigns a value to the Range of cells C3:F6
'The value is the value of the variable Comment
Range("C3:F6") = Comment
'This assigns a value to the Excel cell C1.
'The value is the value of the Excel cell C1
'concatenated with " > " concatenated with the
'value of the variable Comment
Cells(1, 3) = Cells(1, 3) & " > " & Comment
End Sub
Sub myThirdSub()
Dim james As Integer
Dim quinn As String
'This assigns a value to the variable james
'The value is the number 69
james = 69
'This assigns a value to the Excel cell E3
'The value is the value of the variable james
Cells(3, 5) = james
'This assigns a value to the variable james
'The value is the current value of the variable
'james + 1
james = james + 1
'This assigns a value to the Excel cell F3
'The value is the value of the variable james
Cells(3, 6) = james
'This assigns a value to the variable quinn
'The value is the text "PSB"
quinn = "PSB FML!"
'This assigns a value to the Excel cell E4
'The value is the value of the variable quinn
Cells(4, 5) = quinn
'This assigns a value to the variable quinn
'The value is the current value of the variable
'quinn CONCATENATED with " Rocks!"
quinn = quinn + " Rocks!"
'This assigns a value to the Excel cell F4
'The value is the value of the variable quinn
Cells(4, 6) = quinn
End Sub
'This ensures all variable are defined
'This is done with a DIM statement
Option Explicit
Sub loop1()
Dim rowNum As Integer
'This is a loop
'It is controlled by variable rowNum
'It goes from 1 to 13
For rowNum = 1 To 13
'This assigns a value to the Excel cell
'row equal to the value of the variable
'rowNum, column C.
'The value is the text "FML!"
Cells(rowNum, 3) = "FML!"
'End loop rowNum
Next rowNum
End Sub
Sub loop2()
Dim rowNum As Integer
'This is a loop
'It is controlled by variable rowNum
'It goes from 1 to 13
For rowNum = 3 To 13 Step 2
'This assigns a value to the Excel cell
'row equal to the value of the variable
'rowNum, column C.
'The value is the text "FML!"
Cells(rowNum, 3) = "FML! (" & rowNum & ")"
'End loop rowNum
Next rowNum
End Sub
Sub loop3()
Dim rowNum As Integer
'This is a loop
'It is controlled by variable rowNum
'It goes from 4 to 13 in steps of 3
For rowNum = 4 To 13 Step 3
'This assigns a value to the Excel cell
'row equal to the value of the variable
'rowNum, column equal to the value of
'the variable rowNum.
'The value is the value of the variable
'rowNum.
Cells(rowNum, rowNum) = rowNum
Cells(rowNum, rowNum).[Link] = rowNum
'End loop rowNum
Next rowNum
MsgBox (rowNum)
End Sub
'This makes Excel a Witch
'This ensures all variables are defined
'This is done by a DIM statement
Option Explicit
Sub makePattern()
Dim rowNum As Integer
Dim colNum As Integer
'Ensure truely random
Randomize
For rowNum = 2 To 11
For colNum = 5 To 14
Cells(rowNum, colNum).[Link] = Int(Rnd * 56) + 1
Cells(rowNum, colNum) = Int(Rnd * 100) + 1
Next colNum
Next rowNum
End Sub
Sub processPattern(lower As Integer, upper As Integer)
Dim rowNum As Integer
Dim colNum As Integer
For colNum = 5 To 14
For rowNum = 2 To 11
If Cells(rowNum, colNum) < lower Then
Cells(rowNum, colNum).[Link] = 3
ElseIf Cells(rowNum, colNum) > upper Then
Cells(rowNum, colNum).[Link] = 4
' ElseIf Cells(rowNum, colNum) > 85 Then
' Cells(rowNum, colNum).[Link] = 13
Else
Cells(rowNum, colNum).[Link] = 0
End If
Next rowNum
Next colNum
End Sub
'Start subroutine getValues
Sub getValues()
'Define variables
Dim iLower As Integer
Dim iUpper As Integer
Dim sLower As String
Dim sUpper As String
' (Get lower value from user)
'This assigns a value to the
'variable lower.
'The value is the return value from
'the Input Box.
getLower:
Do
sLower = InputBox("Please enter lower value ( 1 - 100 )")
Loop While IsNumeric(sLower) = False And sLower <> vbNullString
'IF Cancel THEN Exit Sub
If sLower = vbNullString Then
MsgBox ("Chicken!")
Exit Sub
ElseIf sLower < 1 Or sLower > 100 Then
MsgBox ("Idiot! Only 1 - 100 !!!")
GoTo getLower
End If
' (Get upper value from user)
'This assigns a value to the
'variable upper.
'The value is the return value from
'the Input Box.
getUpper:
Do
sUpper = InputBox("Please enter upper value ( " & sLower & " - 100 )")
Loop While IsNumeric(sUpper) = False And sUpper <> vbNullString
'IF Cancel THEN Exit Sub
If sUpper = vbNullString Then
Exit Sub
ElseIf sUpper < sLower Or sUpper > 100 Then
MsgBox ("Fool! Must be between " & sLower & " and 100")
GoTo getUpper
End If
'Transfer STRING version of variables to INTEGER version
'This assigns a value to the
'variable iLower.
'The value is the value of
'the variable sLower
iLower = sLower
'This assigns a value to the
'variable iUpper.
'The value is the value of
'the variable sUpper
iUpper = sUpper
'Call processPattern passing INTEGER variables
Call processPattern(iLower, iUpper)
'End subroutine
End Sub
'This makes Excel a *itch
'This ensures all variables are defined
'as VBA is now STRONGLY TYPED
' (This is done with a DIM statement)
Option Explicit
'Define GLOBAL variables
Dim iNumberToGuess As Integer
'Start subroutine newGame
Sub newGame()
'Define LOCAL variables
Dim sUpperLimit As String
'Ensure TRUELY random
Randomize
'-----------------------------------------------
getUpperLimit:
'Ask user how big are their brains
Do
sUpperLimit = InputBox("How high can you go?")
Loop While IsNumeric(sUpperLimit) = False And sUpperLimit <> vbNullString
'IF cancel or X then message and quit
If sUpperLimit = vbNullString Then
MsgBox ("CHICKEN !!!!")
Exit Sub
'ELSEIF negative THEN error message and get new number
ElseIf sUpperLimit < 1 Then
MsgBox ("YOU ARE STUPID! Only positive numbers!")
GoTo getUpperLimit
End If
'-----------------------------------------------
'Generate random number 1 to
'value of upper limit variable
'and assign this to the
'variable iNumberToGuess
iNumberToGuess = Int(Rnd * sUpperLimit) + 1
'Clear and positon to Guess Cell (E3)
Cells(3, 5) = ""
Cells(3, 5).Select
'Display remaining guesses
Cells(1, 3) = "Remaining Guesses :"
Cells(1, 5) = Int(sUpperLimit / 5)
'Display value of variable iNumberToGuess
MsgBox (iNumberToGuess)
'End subroutine
End Sub
'Start subroutine checkGuess
Sub checkGuess()
'Define LOCAL variables
Dim iUserAttempt As Integer
Dim sUserAttempt As String
'Get user attempt STRING version
sUserAttempt = Cells(3, 5)
'IF blank THEN error message
If sUserAttempt = "" Then
MsgBox ("Please enter a value")
'ELSEIF non numeric THEN error message
ElseIf IsNumeric(sUserAttempt) = False Then
MsgBox ("IDIOT! Only numbers please!")
'ELSEIF outside range THEN error message
ElseIf sUserAttempt < 1 Or sUserAttempt > 20 Then
MsgBox ("STUPID! Between 1 and 20 only!")
'ELSEIF no remaining guesses THEN error message
ElseIf Cells(1, 5) < 1 Then
MsgBox ("No more guesses remain! You've lost!")
Else
'when we get here, no errors, so set up
'value of INTEGER version of user attempt
'This assigns a value to the
'variable iUserAttempt.
'The value is the value of the
'variable sUserAttempt
' (move STRING variable value to
' INTEGER variable value)
iUserAttempt = sUserAttempt
'IF correct THEN success message
If iUserAttempt = iNumberToGuess Then
MsgBox ("DAMN! You got it right!")
Else
'Guess is too high or too low
If iUserAttempt < iNumberToGuess Then
MsgBox ("Wrong! Ha Ha Ha! Try HIGHER!")
ElseIf iUserAttempt > iNumberToGuess Then
MsgBox ("Hee hee hee! Wrong! Try LOWER!")
End If
'Reduce remaining guesses by 1
Cells(1, 5) = Cells(1, 5) - 1
'If no more remaining guesses then message
If Cells(1, 5) < 1 Then
MsgBox ("Too Slow! You lost! LOSER!")
End If
End If
End If
'End subroutine
End Sub
Sub sub1()
'Define LOCAL variables
Dim james As Integer
iNumberToGuess = 1969
james = 69
MsgBox (james)
Call sub2
MsgBox (james)
MsgBox (iNumberToGuess)
End Sub
Sub sub2()
'Define LOCAL variables
Dim james As String
james = "PSB Rocks!!!"
MsgBox (james)
MsgBox (iNumberToGuess)
iNumberToGuess = 13
End Sub
This makes Excel a *itch
'This ensures all variables are defined
'as VBA is now STRONGLY TYPED
' (This is done with a DIM statement)
Option Explicit
'Define GLOBAL variables
Dim iNumberToGuess As Integer
Dim sUpperLimit As String
'Start subroutine newGame
Sub newGame()
'Define LOCAL variables
'Ensure TRUELY random
Randomize
'-----------------------------------------------
getUpperLimit:
'Ask user how big are their brains
Do
sUpperLimit = InputBox("How high can you go?")
Loop While IsNumeric(sUpperLimit) = False And sUpperLimit <> vbNullString
'IF cancel or X then message and quit
If sUpperLimit = vbNullString Then
MsgBox ("CHICKEN !!!!")
Exit Sub
'ELSEIF negative THEN error message and get new number
ElseIf sUpperLimit < 1 Then
MsgBox ("YOU ARE STUPID! Only positive numbers!")
GoTo getUpperLimit
End If
'-----------------------------------------------
'Generate random number 1 to
'value of upper limit variable
'and assign this to the
'variable iNumberToGuess
iNumberToGuess = Int(Rnd * sUpperLimit) + 1
'Clear and positon to Guess Cell (E3)
Cells(3, 5) = ""
Cells(3, 5).Select
'Display remaining guesses
Cells(1, 3) = "Remaining Guesses :"
Cells(1, 5) = Int(sUpperLimit / 5)
'Display value of variable iNumberToGuess
MsgBox (iNumberToGuess)
'End subroutine
End Sub
'Start subroutine checkGuess
Sub checkGuess()
'Define LOCAL variables
Dim iUserAttempt As Integer
Dim sUserAttempt As String
'Get user attempt STRING version
sUserAttempt = Cells(3, 5)
'IF blank THEN error message
If sUserAttempt = "" Then
MsgBox ("Please enter a value")
'ELSEIF non numeric THEN error message
ElseIf IsNumeric(sUserAttempt) = False Then
MsgBox ("IDIOT! Only numbers please!")
'ELSEIF outside range THEN error message
ElseIf sUserAttempt < 1 Or sUserAttempt > sUpperLimit Then
MsgBox ("STUPID! Between 1 and " & sUpperLimit & " only!")
'ELSEIF no remaining guesses THEN error message
ElseIf Cells(1, 5) < 1 Then
MsgBox ("No more guesses remain! You've lost!")
Else
'when we get here, no errors, so set up
'value of INTEGER version of user attempt
'This assigns a value to the
'variable iUserAttempt.
'The value is the value of the
'variable sUserAttempt
' (move STRING variable value to
' INTEGER variable value)
iUserAttempt = sUserAttempt
'IF correct THEN success message
If iUserAttempt = iNumberToGuess Then
MsgBox ("DAMN! You got it right!")
Else
'Guess is too high or too low
If iUserAttempt < iNumberToGuess Then
MsgBox ("Wrong! Ha Ha Ha! Try HIGHER!")
ElseIf iUserAttempt > iNumberToGuess Then
MsgBox ("Hee hee hee! Wrong! Try LOWER!")
End If
'Reduce remaining guesses by 1
Cells(1, 5) = Cells(1, 5) - 1
'If no more remaining guesses then message
If Cells(1, 5) < 1 Then
MsgBox ("Too Slow! You lost! LOSER!")
End If
End If
End If
'End subroutine
End Sub
Sub sub1()
'Define LOCAL variables
Dim james As Integer
iNumberToGuess = 1969
james = 69
MsgBox (james)
Call sub2
MsgBox (james)
MsgBox (iNumberToGuess)
End Sub
Sub sub2()
'Define LOCAL variables
Dim james As String
james = "PSB Rocks!!!"
MsgBox (james)
MsgBox (iNumberToGuess)
iNumberToGuess = 13
End Sub
'ColorIndex values:
' 0 = none
' 1 = black
' 2 = white
' 3 = red
' 4 = green
' 5 = blue
' 6 = yellow
Sub yellowLoop()
colNum = 3
For rowNum = 2 To 5
'-----------------------------
'Set back to yellow
'-----------------------------
'This assigns a value to the
'ColorIndex property of the
'Interior property of the
'Excel cell at row equal to
'the value of variable rowNul,
'column equal to the value
'of variable colNum.
'The value is the number 6
Cells(rowNum, colNum).[Link] = 6
If rowNum = 2 Then
Cells(rowNum, colNum) = "Andy"
ElseIf rowNum = 3 Then
Cells(rowNum, colNum) = "Bill"
ElseIf rowNum = 4 Then
Cells(rowNum, colNum) = "Chloe"
ElseIf rowNum = 5 Then
Cells(rowNum, colNum) = "David"
End If
colNum = colNum + 3
Next rowNum
End Sub
Sub redLoop()
'Initialise colNum
colNum = 13
For rowNum = 12 To 15
Cells(rowNum, colNum).[Link] = 3
colNum = colNum - 1
Next rowNum
End Sub
Sub blueLoop()
james = 3
For rowNum = 9 To 19 Step 5
For colNum = 3 To 7 Step 2
Cells(rowNum, colNum).[Link] = james
Cells(rowNum, colNum) = james
james = james + 2
Next colNum
Next rowNum
End Sub
Sub blueLoopNEW()
james = 3
For colNum = 3 To 7 Step 2
For rowNum = 9 To 19 Step 5
Cells(rowNum, colNum).[Link] = james
Cells(rowNum, colNum) = james
james = james + 2
Next rowNum
Next colNum
End Sub
Option Explicit
Sub yellowLoop()
Dim yellow As Integer
'This is a loop
'It uses the variable yellow to control the loop
'It will have the values 2, 3, 4 and 5
For yellow = 2 To 5
Cells(yellow + 1, yellow).[Link] = 6
Next yellow
End Sub
Sub yellowLoop2()
Dim yellow As Integer
'This is a loop
'It uses the variable yellow to control the loop
'It will have the values 2, 3, 4 and 5
For yellow = 2 To 5
Cells(yellow + 1, yellow).[Link] = 6
Next yellow
End Sub
Sub redLoop()
colNumber = 7
For red = 3 To 9 Step 2
Cells(red, colNumber).[Link] = 3
colNumber = colNumber + 1
Next red
End Sub
Sub redLoop2()
'This assigns the numeric value 3 to the VBA variable rowNumber
rowNumber = 3
For red = 7 To 10
Cells(rowNumber, red).[Link] = 3
rowNumber = rowNumber + 2
Next red
End Sub
Sub blueLoop()
Dim rowNumb As Integer
Dim blue As Integer
rowNumb = 12
For blue = 2 To 8 Step 3
Cells(rowNumb, blue).[Link] = 5
rowNumb = rowNumb - 1
Next blue
End Sub
Sub blueLoop3()
Dim rowNumb As Integer
Dim blue As Integer
rowNumb = 12
For blue = 2 To 8 Step 3
Cells(rowNumb, blue).[Link] = 5
rowNumb = rowNumb - 1
Next blue
End Sub
Sub blueLoop2()
Dim colNumb As Integer
Dim rowNumb As Integer
colNumb = 8
For rowNumb = 10 To 12
Cells(rowNumb, colNumb).[Link] = 5
colNumb = colNumb - 3
Next rowNumb
End Sub
Sub blackLoop()
Dim rowNumb As Integer
Dim colNumb As Integer
Dim difference As Integer
colNumb = 2
difference = 1
For rowNumb = 15 To 19
Cells(rowNumb, colNumb).[Link] = 1
colNumb = colNumb + difference
difference = difference + 1
Next rowNumb
End Sub
Sub greenLoop()
Dim rowNumb As Integer
Dim colNumb As Integer
Dim difference As Integer
colNumb = 2
difference = 2
For rowNumb = 21 To 28
Cells(rowNumb, colNumb).[Link] = 4
colNumb = colNumb + difference
difference = difference * -1
Next rowNumb
End Sub
Sub orangeLoop()
Dim colNumb As Integer
Dim rowNumb As Integer
Dim difference As Integer
colNumb = 6
difference = 1
For rowNumb = 20 To 28
Cells(rowNumb, colNumb).[Link] = 44
colNumb = colNumb + difference
If colNumb = 8 Then
difference = -1
ElseIf colNumb = 6 Then
difference = 1
End If
Next rowNumb
End Sub
'Start subroutine checkAge
Sub checkAge()
'Start of Loop
Do
age = InputBox("Please enter your age")
'End loop
'Will loop while value of variable age
'not numeric and not cancel
Loop While IsNumeric(age) = False And age <> vbNullString
'Start of IF statement
If age = vbNullString Then
MsgBox ("Loser!")
Exit Sub
ElseIf age > 30 Then
MsgBox ("Too Old!!!")
ElseIf age < 18 Then
MsgBox ("Too Young!!!")
Else
MsgBox ("Perfect!")
'End of IF statement
End If
'End subroutine
End Sub
'Start subroutine sillySub
Sub sillySub()
'Define variables
Dim james As Integer
Dim fontColor As Integer
Dim backColor As Integer
'This is a loop using variable james
'It goes from 3 to 9
For james = 3 To 9
'Assign a random number between 1 and 56 to variable fontColor
fontColor = Int(Rnd * 56) + 1
'Assign a random number between 1 and 56 to variable backColor
backColor = Int(Rnd * 56) + 1
'Assign value james * 5 to Excel cell,
'Font color to value of variable fontColor
'Background color to value of variable backColor
Cells(james, james + 2) = james * 5
Cells(james, james + 2).[Link] = fontColor
Cells(james, james + 2).[Link] = backColor
'End loop james
Next james
'End siubroutine
End Sub
Sub sillyLoops()
'--------------------------------------------------
' Loop a)
'--------------------------------------------------
Content = 4
For rowNum = 2 To 8 Step 2
For colNum = 2 To 8 Step 2
Cells(rowNum, colNum) = Content
Cells(rowNum, colNum).[Link] = Content
Content = Content + 1
Next colNum
Next rowNum
'--------------------------------------------------
' Loop b)
'--------------------------------------------------
colNum = 3
For rowNum = 15 To 19
Cells(rowNum, colNum).[Link] = 3
If rowNum = 15 Then
Content = "All"
ElseIf rowNum = 16 Then
Content = "Boys"
ElseIf rowNum = 17 Then
Content = "Cry"
ElseIf rowNum = 18 Then
Content = "Deeply"
Else
Content = "Everyday"
End If
Cells(rowNum, colNum) = Content
colNum = colNum + 1
Next rowNum
'--------------------------------------------------
' Loop c)
'--------------------------------------------------
colNum = 11
For rowNum = 19 To 15 Step -1
Cells(rowNum, colNum).[Link] = 4
colNum = colNum + 1
Next rowNum
'--------------------------------------------------
' Loop d)
'--------------------------------------------------
colNum = 2
diff = 2
For rowNum = 21 To 24
Cells(rowNum, colNum).[Link] = 1
Cells(rowNum, colNum).[Link] = 2
Cells(rowNum, colNum) = diff / 2
colNum = colNum + diff
diff = diff * 2
Next rowNum
End Sub
'This makes Excel a *itch
'This ensures all variables are defined
'This is done with DIM statements
'VBA is now STRONGLY TYPED
Option Explicit
'Define GLOBAL variables
Dim wordToGuess As String
Dim userAttempt As String
Dim x As Integer
Dim bodyPartsLeft As Integer
'Start of subroutine newGame
Sub newGame()
'Define LOCAL variables
Dim lastRow As Integer
Dim randomRow As Integer
Dim lengthOfWord As Integer
'Ensure truely random
Randomize
'Get last row with data
'This assigns a value to the
'variable lastRow. The value is
'number of the last row with data
lastRow = Worksheets("words").Columns("A").Find("*", , xlValues, , xlRows,
xlPrevious).Row
'This assigns a value to the
'variable randomRow.
'It is a random number between 1
'and the value of variable lastRow
randomRow = Int(Rnd * lastRow) + 1
'This assigns a value to the
'variable wordToGuess.
'The value is retrieved from the
'Excel cell in the worksheet
'WORDS at line equal to value of
'variable randomRow, column A
wordToGuess = Worksheets("words").Cells(randomRow, 1)
'This assigns a value to the
'variable lengthOfWord
'The value is the length of
'the variable wordToGuess
lengthOfWord = Len(wordToGuess)
'Display length of word
Cells(9, 3) = "Your word has " & lengthOfWord & " letters:"
'Construct User Attempt
userAttempt = ""
For x = 1 To lengthOfWord
userAttempt = userAttempt & " -"
Next x
'Display User Attempt
Cells(10, 2) = userAttempt
'Set background color and clear Win / Lose message
Range("A1:ZZ300").[Link] = 2
Cells(17, 5) = ""
Cells(17, 5).[Link] = 64
'Merge B10 to E11
Range("B10:E11").Merge
Range("B10:E11").HorizontalAlignment = xlCenter
Range("B10:E11").VerticalAlignment = xlCenter
'This assigns a value to
'the ColorIndex property of
'the Font property of
'the Range of Excel cells B10:E11
'The value is the number 2
Range("B10:E11").[Link] = 2
Range("B10:E11").[Link] = 18
Range("B10:E11").[Link] = 11
'Merge G10 to H11
Range("G10:H11").Merge
Range("G10:H11").HorizontalAlignment = xlCenter
Range("G10:H11").VerticalAlignment = xlCenter
Range("G10:H11").[Link] = 2
Range("G10:H11").[Link] = 18
Range("G10:H11").[Link] = 11
'Position and clear G10
Cells(10, 7).Select
Cells(10, 7) = ""
'Clear message cell J11
Cells(11, 10).ClearContents
'Display titles and clear letters
Cells(14, 7) = "Correct:"
Cells(15, 7) = "Wrong:"
Cells(14, 8).ClearContents
Cells(15, 8).ClearContents
'Set number of body parts for wrong guesses
bodyPartsLeft = 10
'Merge J2 to J8
Range("J2:J8").[Link] = "Courier New"
Range("J2:J8").[Link] = True
Range("J2:J8").[Link] = 11
Range("J2:J8").[Link] = 37
Range("J2:J8") = ""
'End of subroutine
End Sub
'Start subroutine checkGuess
Sub checkGuess()
'Define LOCAL variables
Dim letterGuess As String
'Get letter and force Upper Case
letterGuess = UCase(Cells(10, 7))
'Clear message cell J11
Cells(11, 10).ClearContents
'Position to guess cell G10
Cells(10, 7).Select
'---------------------------------------------------
'Validate User Input:
'---------------------------------------------------
'IF guessed the word THEN error
If InStr(1, userAttempt, "-") = 0 Then
Cells(11, 10) = "BIRD BRAIN! You've already Won!!!"
'ELSE IF already lost THEN error
ElseIf bodyPartsLeft <= 0 Then
Cells(11, 10) = "OY! You've lost! No more guesses!"
'ELSE IF Blank THEN error
ElseIf letterGuess = "" Then
Cells(11, 10) = "STUPID! Enter something!"
'ELSE IF not a letter THEN error
ElseIf letterGuess < "A" Or letterGuess > "Z" Then
Cells(11, 10) = "FOOL! Enter a letter!"
'ELSE IF entered more than 1 character THEN error
ElseIf Len(letterGuess) > 1 Then
Cells(11, 10) = "IDIOT! Only 1 character at a time!"
'ELSE IF already tried that letter THEN error
ElseIf InStr(1, Cells(14, 8), letterGuess) > 0 Or InStr(1, Cells(15, 8), letterGuess) > 0 Then
Cells(11, 10) = "OYSTER BRAIN! You've already tried that letter!"
'---------------------------------------------------
'ELSE IF GET HERE, THEN LEGO MOVIE (LIFE IS AWESOME!)
'---------------------------------------------------
Else
'Get position of user guess letter in word to Guess
x = InStr(1, wordToGuess, letterGuess)
'IF letter does not exist in word THEN message and add to wrong list
If x = 0 Then
Cells(11, 10) = "Ha Ha! Wrong! The noose is tightening!"
Cells(15, 8) = Cells(15, 8) & " " & letterGuess
'Decrement number of body parts left
bodyPartsLeft = bodyPartsLeft - 1
'CALL subroutine to update image
Call oneStepCloserToDeath
'IF no more body parts left THEN you are dead
If bodyPartsLeft <= 0 Then
Cells(17, 5) = "L O S E R !!!"
Cells(11, 10) = ""
End If
'ELSE letter does exist in word so add to correct list
Else
Cells(11, 10) = "Damn! You got a letter!"
Cells(14, 8) = Cells(14, 8) & " " & letterGuess
'Replace hyphens with guess letter
Do
userAttempt = Left(userAttempt, (x * 3) - 1) & letterGuess & Mid(userAttempt, (x *
3) + 1)
x = InStr((x + 1), wordToGuess, letterGuess)
Loop While x > 0
'Display revealed letters
Cells(10, 2) = userAttempt
'IF no more hyphens THEN success
If InStr(1, userAttempt, "-") = 0 Then
Call success
End If
End If
End If
'End subroutine
End Sub
Sub success()
Cells(17, 5) = "W I N N E R !!!"
'LOOP to change background color
For x = 1 To 56
Range("A1:ZZ300").[Link] = x
Next x
'ReSet background colors
Range("A1:ZZ300").[Link] = 2
Cells(10, 2).[Link] = 11
Cells(10, 7).[Link] = 11
Range("J2:J8").[Link] = 37
End Sub
Sub oneStepCloserToDeath()
If bodyPartsLeft = 9 Then
Cells(8, 10) = "'========="
ElseIf bodyPartsLeft = 8 Then
Cells(3, 10) = "' |"
Cells(4, 10) = "' |"
Cells(5, 10) = "' |"
Cells(6, 10) = "' |"
Cells(7, 10) = "' |"
ElseIf bodyPartsLeft = 7 Then
Cells(2, 10) = "' ======="
ElseIf bodyPartsLeft = 6 Then
Cells(3, 10) = "' \ |"
Cells(4, 10) = "' \|"
ElseIf bodyPartsLeft = 5 Then
Cells(2, 10) = "' .======="
Cells(3, 10) = "' : \ |"
ElseIf bodyPartsLeft = 4 Then
Cells(4, 10) = "' o |"
Cells(5, 10) = "' | |"
ElseIf bodyPartsLeft = 3 Then
Cells(6, 10) = "'/ |"
ElseIf bodyPartsLeft = 2 Then
Cells(6, 10) = "'/ \ |"
ElseIf bodyPartsLeft = 1 Then
Cells(5, 10) = "'-| |"
ElseIf bodyPartsLeft = 0 Then
Cells(5, 10) = "'-|- |"
End If
End Sub
Option Explicit
Sub getJames()
Dim stNumberLetters As String
Dim iNumberLetters As Integer
getNumberOfLetters:
Do
stNumberLetters = InputBox("How many letters (3-10)")
Loop While IsNumeric(stNumberLetters) = False And stNumberLetters <> vbNullString
If stNumberLetters = vbNullString Then
MsgBox ("Why?")
Exit Sub
ElseIf stNumberLetters < 3 Then
MsgBox ("Minimum 3")
GoTo getNumberOfLetters
ElseIf stNumberLetters > 10 Then
MsgBox ("Maximum 10")
GoTo getNumberOfLetters
Else
iNumberLetters = stNumberLetters
processJames (iNumberLetters)
End If
End Sub
Sub processJames(iNumberLetters As Integer)
Dim stCode As String
Dim iRand As Integer
Dim iCount As Integer
stCode = "!;"
For iCount = 1 To iNumberLetters
iRand = Int(Rnd * 3) + 1
If iRand = 1 Then
stCode = stCode & ":"
ElseIf iRand = 2 Then
stCode = stCode & "/"
ElseIf iRand = 3 Then
stCode = stCode & "!"
End If
Next iCount
MsgBox ("Your code is : " & stCode)
End Sub
Sub jamesLoops()
Dim rowNum As Integer
Dim colNum As Integer
Dim contents As Integer
Dim word As String
'-----------------------------------------------
' Loop a)
'-----------------------------------------------
contents = 13
For rowNum = 1 To 10 Step 3
For colNum = 3 To 9 Step 2
Cells(rowNum, colNum) = contents
Cells(rowNum, colNum).[Link] = contents
contents = contents + 1
Next colNum
Next rowNum
'-----------------------------------------------
' Loop b)
'-----------------------------------------------
colNum = 3
For rowNum = 15 To 19
Cells(rowNum, colNum).[Link] = 4
colNum = colNum + 1
Next rowNum
'-----------------------------------------------
' Loop c)
'-----------------------------------------------
colNum = 15
For rowNum = 15 To 19
Cells(rowNum, colNum).[Link] = 3
If rowNum = 15 Then
word = "Everyday"
ElseIf rowNum = 16 Then
word = "Deeply"
ElseIf rowNum = 17 Then
word = "Cry"
ElseIf rowNum = 18 Then
word = "Boys"
ElseIf rowNum = 19 Then
word = "All"
End If
Cells(rowNum, colNum) = word
colNum = colNum - 1
Next rowNum
'-----------------------------------------------
' Loop d)
'-----------------------------------------------
colNum = 2
contents = 16
For rowNum = 21 To 25
Cells(rowNum, colNum).[Link] = 1
Cells(rowNum, colNum) = contents
contents = contents / 2
colNum = colNum + contents
Next rowNum
End Sub
