Homework_2 BMI Report

Send Snippet To: Save this snippet to Code Collector Pro -- view all surfrgeek's snippets
language: Other
license: Other

Code for Snippet:

                
Option Explicit
 
Sub USERBMIREPORT()
    'Declare variables
    Dim firstName, lastName, userWeight, userHeightFeet, userHeightInches, weightStatus, response, output As String 'Always declare string types for data to be entered from keyboard
    Dim userBMI, totalInches As Double
    Dim isValid As Boolean        'Flag to terminate the DO LOOP
 
    'INPUT SECTION: ***** FIRST NAME *****************************************************************
    'Capture First Name from keyboard inside a DO LOOP
    isValid = False                    'Initialize the flag to false and convert it to TRUE if conditions are met
    Do
        firstName = InputBox("Please enter your First Name (e.g., John); ", "FIRST NAME")  'MsgBox Header must reflect Data asked for
 
        'Check if the input is NULL
        If firstName = "" Then
            'Check if user wants to quit
            response = MsgBox("Empty Input. Do you want to quit?", vbYesNo, "QUIT?")  'Header reflects QUIT scenario
            If response = vbYes Then
                Exit Sub                'Exit the entire Sub; no point in continuing with other stuff at bottom
 
 
            Else
                'Not quitting; display proper error message and continue validation
                MsgBox "You must enter a valid value (e.g., John)" ' vbExclamation, "NO DATA ENTRY"  'Header reflects no Data Entry scenario
            End If
 
        'Input not blank; validate input for other requirements
 
        'Check if input is non-numeric
        ElseIf IsNumeric(firstName) Then
            MsgBox "First Name must be a non-numeric value (e.g., John)", vbExclamation, "NUMERIC ENTRY"  'Header reflects non-numeric scenario
 
        'If the control reaches here, it means the input is valid; change the Flag to "True" to exit DO LOOP
        Else
            isValid = True
 
        End If
 
    Loop Until isValid = True
 
 
    'INPUT SECTION: ***** LAST NAME *****************************************************************
    'Capture Last Name from keyboard inside a DO LOOP
    isValid = False                    'Initialize the flag to false and convert it to TRUE if conditions are met
    Do
        lastName = InputBox("Please enter your Last Name (e.g., Smith); ", "LAST NAME")  'MsgBox Header must reflect Data asked for
 
        'Check if the input is NULL
        If lastName = "" Then
            'Check if user wants to quit
            response = MsgBox("Empty Input. Do you want to quit?", vbYesNo, "QUIT?")  'Header reflects QUIT scenario
            If response = vbYes Then
                Exit Sub                'Exit the entire Sub; no point in continuing with other stuff at bottom
 
 
            Else
                'Not quitting; display proper error message and continue validation
                MsgBox "You must enter a valid value (e.g., Smith)" ' vbExclamation, "NO DATA ENTRY"  'Header reflects no Data Entry scenario
            End If
 
        'Input not blank; validate input for other requirements
 
        'Check if input is non-numeric
        ElseIf IsNumeric(lastName) Then
            MsgBox "Last Name must be a non-numeric value (e.g., Smith)", vbExclamation, "NUMERIC ENTRY"  'Header reflects non-numeric scenario
 
        'If the control reaches here, it means the input is valid; change the Flag to "True" to exit DO LOOP
        Else
            isValid = True
 
        End If
 
    Loop Until isValid = True
 
    'INPUT SECTION: ***** USER HEIGHT FEET ***********************************************
    'Capture User Height in Feet from keyboard inside a DO LOOP
    isValid = False                    'Initialize the flag to false and convert it to TRUE if conditions are met
    Do
        userHeightFeet = InputBox("Please enter your height in feet (e.g., 6); ", "USER HEIGHT IN FEET")  'MsgBox Header must reflect Data asked for
 
        'Check if the input is NULL
        If userHeightFeet = "" Then
            'Check if user wants to quit
            response = MsgBox("Empty Input. Do you want to quit?", vbYesNo, "QUIT?")  'Header reflects QUIT scenario
            If response = vbYes Then
                Exit Sub                'Exit the entire Sub; no point in continuing with other stuff at bottom
 
 
            Else
                'Not quitting; display proper error message and continue validation
                MsgBox "You must enter a valid numeric value (e.g., 6)" ' vbExclamation, "NO DATA ENTRY"  'Header reflects no Data Entry scenario
            End If
 
        'Input not blank; validate input for other requirements
 
        'Check if input is numeric
        ElseIf Not IsNumeric(userHeightFeet) Then
            MsgBox "Your height in feet must be a numeric value (e.g., 6)", vbExclamation, "NON-NUMERIC ENTRY"  'Header reflects non-numeric scenario
 
        'Input is numeric but check if it is positive number less than 3
        ElseIf userHeightFeet < 3 Then
            MsgBox "Your height in feet must be a whole number between 3 and 8 (e.g., 6)", vbExclamation, "OUT OF LOWER RANGE ENTRY"  'Header reflects out of lower Range scenario
 
        'Input is positive numeric; check if it is a DECIMAL number
        ElseIf InStr(userHeightFeet, ".") <> 0 Then
            MsgBox "Your height in feet must be a whole number (e.g., 6)", vbExclamation, "DECIMAL ENTRY"  'Header reflects decimal entry scenario
 
        'Input must be positive number less than or equal to 8
        ElseIf userHeightFeet > 8 Then
            MsgBox "Your height in feet must be a whole number between 3 and 8 (e.g., 6)", vbExclamation, "OUT OF UPPER RANGE ENTRY"  'Header reflects out of upper range entry scenario
 
        'If the control reaches here, it means the input is valid; change the Flag to "True" to exit DO LOOP
        Else
            isValid = True
 
        End If
 
    Loop Until isValid = True
 
 
    'INPUT SECTION: ***** USER HEIGHT IN INCHES ***********************************************
    'Capture User Height in Inches from keyboard inside a DO LOOP
    isValid = False                    'Initialize the flag to false and convert it to TRUE if conditions are met
    Do
        userHeightInches = InputBox("Please enter the inches over " & userHeightFeet & " feet you are (e.g., 3); ", "USER HEIGHT IN INCHES")  'MsgBox Header must reflect Data asked for
 
        'Check if the input is NULL
        If userHeightInches = "" Then
            'Check if user wants to quit
            response = MsgBox("Empty Input. Do you want to quit?", vbYesNo, "QUIT?")  'Header reflects QUIT scenario
            If response = vbYes Then
                Exit Sub                'Exit the entire Sub; no point in continuing with other stuff at bottom
 
 
            Else
                'Not quitting; display proper error message and continue validation
                MsgBox "You must enter a valid numeric value (e.g., 3.25)" ' vbExclamation, "NO DATA ENTRY"  'Header reflects no Data Entry scenario
            End If
 
        'Input not blank; validate input for other requirements
 
        'Check if input is numeric
        ElseIf Not IsNumeric(userHeightInches) Then
            MsgBox "Your height in inches over " & userHeightFeet & " feet must be a numeric value (e.g., 3)", vbExclamation, "NON-NUMERIC ENTRY"  'Header reflects non-numeric scenario
 
        'Input is numeric but check if it is positive number greater than or equal to 0
        ElseIf userHeightInches < 0 Then
            MsgBox "Your height in inches must be a whole number between 0 and 11 (e.g., 6)", vbExclamation, "OUT OF LOWER RANGE ENTRY"  'Header reflects out of lower range entry scenario
 
        'Input is positive numeric; check if it is a DECIMAL number
        ElseIf InStr(userHeightInches, ".") <> 0 Then
            MsgBox "Your height in inches over " & userHeightFeet & " feet must be a whole number (e.g., 3)", vbExclamation, "DECIMAL ENTRY"  'Header reflects decimal entry scenario
 
        'Input must be positive number less than or equal to 11
        ElseIf userHeightInches > 11 Then
            MsgBox "Your height in inches must be a whole number between 0 and 11 (e.g., 6)", vbExclamation, "OUT OF UPPER RANGE ENTRY"  'Header reflects out of upper range entry scenario        'If the control reaches here, it means the input is valid; change the Flag to "True" to exit DO LOOP
 
        Else
            isValid = True
 
        End If
 
    Loop Until isValid = True
 
 
    'INPUT SECTION: ***** USER WEIGHT *****************************************************************
    'Capture User Weight from keyboard inside a DO LOOP
    isValid = False                    'Initialize the flag to false and convert it to TRUE if conditions are met
    Do
        userWeight = InputBox("Please enter your weight in pounds (e.g., 155.3); ", "USER WEIGHT")  'MsgBox Header must reflect Data asked for
 
        'Check if the input is NULL
        If userWeight = "" Then
            'Check if user wants to quit
            response = MsgBox("Empty Input. Do you want to quit?", vbYesNo, "QUIT?")  'Header reflects QUIT scenario
            If response = vbYes Then
                Exit Sub                'Exit the entire Sub; no point in continuing with other stuff at bottom
 
 
            Else
                'Not quitting; display proper error message and continue validation
                MsgBox "You must enter a valid numeric value (e.g., 155.3)" ' vbExclamation, "NO DATA ENTRY"  'Header reflects no Data Entry scenario
            End If
 
        'Input not blank; validate input for other requirements
 
        'Check if input is numeric
        ElseIf Not IsNumeric(userWeight) Then
            MsgBox "Miles Traveled must be a numeric value (e.g., 155.3)", vbExclamation, "NON-NUMERIC ENTRY"  'Header reflects non-numeric scenario
 
        'Input is numeric but check if it is positive
        ElseIf userWeight < 0 Then
            MsgBox "User Weight cannot be a negative value", vbExclamation, "NEGATIVE ENTRY"  'Header reflects negative entry scenario
 
        'If the control reaches here, it means the input is valid; change the Flag to "True" to exit DO LOOP
        Else
            isValid = True
 
        End If
 
    Loop Until isValid = True
 
 
    'PROCESSING SECTION: ***** CALCULATE BMI ******************************************************
    'NOTE: All string values must be converted to corresponding NUMERIC before you do the calculation.
 
    totalInches = CInt(userHeightFeet * 12) + CInt(userHeightInches)
 
    userBMI = CDbl(userWeight) / CInt(totalInches ^ 2) * 703 ' BMI Calculation (703 is a constatnt)
 
    Select Case userBMI
 
        Case Is < 18.5
            weightStatus = "Underweight"
        Case 18.5 To 24.9
            weightStatus = "Normal"
        Case 25 To 29.9
            weightStatus = "Overweight"
        Case Is >= 30
            weightStatus = "Obese"
 
    End Select
 
    'OUTPUT SECTION: ***** DISPLAY SCREEN OUTPUT *********************************************************
    'Formulate an output string with nice formatting
    '"vbTab" is a built-in constant that pushes the disply one TAB to the right
    '"vbCrLf" is a built-in constant that pushes display to the start of the next line
 
    output = WorksheetFunction.Rept("=", 30) & vbCrLf    'Repeat the char "=" 30 times on screen
    output = output & "User Name: " & Format(firstName) & " " & Format(lastName) & vbCrLf
    output = output & "Height (in feet portion): " & Format(userHeightFeet, "#") & vbCrLf
    output = output & "Height (in inches portion): " & Format(userHeightInches, "#0") & vbCrLf
    output = output & "Weight (in lbs.): " & Format(userWeight, "###.0") & vbCrLf
    output = output & "BMI: " & Format(userBMI, "##.#") & vbCrLf
    output = output & "Weight Status: " & weightStatus & vbCrLf
    output = output & WorksheetFunction.Rept("=", 30)              'Repeat the char "=" 30 times on screen
 
    'Display output string
    MsgBox output, vbInformation, "BMI SUMMARY"
 
End Sub
comments powered by Disqus

Info

Link to this snippet:


Download to Code Collector

To use the direct link to your snippet on CodeCollector.net either copy the html from the above section or drag the Download to Code Collector to where you would like to use it.

More Info:

Times Viewed: 24
Date Added: 2017-09-06 16:35:32
Last Modified: 2017-09-09 14:05:31

Web Analytics