Page 1 of 2 12 LastLast
Results 1 to 15 of 21
  1. #1
    5 Star Lounger
    Join Date
    Jun 2001
    Location
    USA
    Posts
    708
    Thanks
    48
    Thanked 1 Time in 1 Post

    Help Me Figure Out a Formula

    Good evening -

    I need help figuring out a formula for my attendance spreadsheet, which is attached.

    There are three values:

    √ = present
    U = unexcused absence
    E = excused absence

    I want to create a column that automatically calculates a student's attendance record.

    There are 12 classes, and only unexcused absences count as "demerits."

    So, if a student attends 11 classes and has an excused absence for 1 class, his cell should say 100%. If a student attends 11 classes and has an unexcused absence for 1 class, his cell should say 92%.

    Can anyone help?

    Thanks a million!

  2. #2
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts
    There is no attachment. I presume that sum of the COUNTIF of the present and COUNTIF of the excused divided by the total count should work. But without know the setup, it is difficult to be more specific.

    Steve

  3. The Following User Says Thank You to sdckapr For This Useful Post:

    Jon5 (2014-09-29)

  4. #3
    Lounger
    Join Date
    Jul 2014
    Posts
    33
    Thanks
    7
    Thanked 3 Times in 3 Posts
    As stated above the example spreadsheet would help figure out what you were after here

    =1-(COUNTIF('Unexcused',"U")/'TotalCount'
    where 'Unexcused' = the column in which the unexcused absences are noted
    and where = 'TotalCount' is the cell which refers to the total number of classes they should have attended

  5. The Following User Says Thank You to Rathril For This Useful Post:

    Jon5 (2014-09-29)

  6. #4
    5 Star Lounger
    Join Date
    Jun 2001
    Location
    USA
    Posts
    708
    Thanks
    48
    Thanked 1 Time in 1 Post
    Hi guys - Thanks so much for your prompt replies. And so sorry for omitting the attachment--here it is. Thanks again.
    Attached Files Attached Files

  7. #5
    Lounger
    Join Date
    Jul 2014
    Posts
    33
    Thanks
    7
    Thanked 3 Times in 3 Posts
    In the current format you could do something like in the spreadsheet I attached.
    Let me know if this helps

    R
    Attached Files Attached Files

  8. The Following User Says Thank You to Rathril For This Useful Post:

    Jon5 (2014-09-29)

  9. #6
    5 Star Lounger
    Join Date
    Jun 2001
    Location
    USA
    Posts
    708
    Thanks
    48
    Thanked 1 Time in 1 Post
    Thanks, Rathril! Thanks did the trick!

  10. #7
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,637
    Thanks
    115
    Thanked 650 Times in 592 Posts
    Jon,

    Here is your attendance record with some code that will toggle your symbols E2 through R20 (Check, E, U, blank) by clicking on the cells. The symbols will change color according to their attendance. Column S has the formula:

    =COUNTIF(E2:R2,"a")+COUNTIF(E2:R2,"E") which will count their total attendance

    There is no need for additional columns. Place the code in a sheet module

    HTH,
    Maud

    Classes1.png

    Code:
    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
     If Target.Cells.Count > 1 Then Exit Sub
        If Not Intersect(Target, Range("E2:R20")) Is Nothing Then
            If Target = vbNullString Then
                Target.Font.Name = "Marlett"
                Target.Font.Color = vbGreen
                Target = "a"
                [a1].Select
            ElseIf Target = "a" Then
                Target.Font.Name = "Calibri"
                Target.Font.Color = vbGreen
                Target = "E"
                [a1].Select
            ElseIf Target = "E" Then
                Target.Font.Name = "Calibri"
                Target.Font.Color = vbRed
                Target = "U"
                [a1].Select
            ElseIf Target = "U" Then
               Target = vbNullString
               [a1].Select
            End If
        End If
    End Sub
    Attached Files Attached Files

  11. The Following User Says Thank You to Maudibe For This Useful Post:

    Jon5 (2014-09-29)

  12. #8
    5 Star Lounger
    Join Date
    Jun 2001
    Location
    USA
    Posts
    708
    Thanks
    48
    Thanked 1 Time in 1 Post
    Thanks, Maudibe! You guys are the best!

  13. #9
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,637
    Thanks
    115
    Thanked 650 Times in 592 Posts
    Jon,

    I wasn't sure if you wanted to incorporate your request from your other thread

    Maud

  14. #10
    3 Star Lounger
    Join Date
    Dec 2009
    Posts
    212
    Thanks
    36
    Thanked 0 Times in 0 Posts
    Maudibe,
    I am trying to understand your code.
    Please explain the lines:
    (a1).select
    If eliminated the scripts stops at that point. Is this to prevent a loop?
    Thanks.

  15. #11
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,435
    Thanks
    372
    Thanked 1,457 Times in 1,326 Posts
    SkiPro,

    The move to A1 is to prevent the user from typing something extraneous in the cell that was just changed as the code would leave that cell active.

    Just for kicks here's another way to code the logic:
    Code:
    Option Explicit
    
    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
     If Target.Cells.Count > 1 Then Exit Sub
        If Not Intersect(Target, Range("E2:R20")) Is Nothing Then
            Select Case Target
             Case vbNullString
                Target.Font.Name = "Marlett"
                Target.Font.Color = vbGreen
                Target = "a"
                [A1].Select
            Case "a"
                Target.Font.Name = "Calibri"
                Target.Font.Color = vbGreen
                Target = "E"
                [A1].Select
            Case "E"
                Target.Font.Name = "Calibri"
                Target.Font.Color = vbRed
                Target = "U"
               [A1].Select
            Case "U"
               Target = vbNullString
               [A1].Select
            End Select
        End If
    End Sub
    HTH
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  16. #12
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,637
    Thanks
    115
    Thanked 650 Times in 592 Posts
    Additionally,
    If the cell you just clicked remains the active cell, you can't click on it again until you click somewhere else then come back to it. In essence, you will not be able to toggle the cell. [A1].select creates the ability to toggle the cell.

    HTH,
    Maud

  17. #13
    3 Star Lounger
    Join Date
    Dec 2009
    Posts
    212
    Thanks
    36
    Thanked 0 Times in 0 Posts
    RG,
    Interesting, did not see that.
    Maud,
    That is what I was seeing, but did not know why. I thought it might have created a continual looping and that was why it would not advanced with additional click.
    Thanks RG & Maud for your answers.

  18. #14
    3 Star Lounger
    Join Date
    Dec 2009
    Posts
    212
    Thanks
    36
    Thanked 0 Times in 0 Posts
    I am using a modification of Maudibe's script above but I find I unintentionally click on cells which changes their intended values. How can I prevent these unintentional changes. Can the cells be easily locked or better, can I add or require a key press in addition to the click [as in Ctrl + click] to change the value?

  19. #15
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,637
    Thanks
    115
    Thanked 650 Times in 592 Posts
    Skipro,

    Here is some added code that will inhibit the cells from changing their values when clicked upon unless the Ctrl-Shft Keys are depressed when the click occurs.

    Current code in the sheet module with added lines (blue):
    Code:
    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    ctrl = IsControlKeyDown()
    shft = IsShiftKeyDown()
    If ctrl And shft Then
        If Not Intersect(Target, Range("E2:R20")) Is Nothing Then
            If Target = vbNullString And IsControlKeyDown Then
                Target.Font.Name = "Marlett"
                Target.Font.Color = vbGreen
                Target = "a"
                [a1].Select
            ElseIf Target = "a" And IsControlKeyDown Then
                Target.Font.Name = "Calibri"
                Target.Font.Color = vbGreen
                Target = "E"
                [a1].Select
            ElseIf Target = "E" And IsControlKeyDown Then
                Target.Font.Name = "Calibri"
                Target.Font.Color = vbRed
                Target = "U"
                [a1].Select
            ElseIf Target = "U" And IsControlKeyDown Then
               Target = vbNullString
               [a1].Select
            End If
        End If
    End If
    End Sub
    Code added to a standard module:
    Code:
    Private Declare Function GetKeyState Lib "user32" ( _
        ByVal nVirtKey As Long) As Integer
    Private Const KEY_MASK As Integer = &HFF80
    
    
    Public Function IsControlKeyDown(Optional LeftOrRightKey As Long = 3) As Boolean
        Dim Res As Long
        Select Case LeftOrRightKey
            Case LeftKey, RightKey
                Res = GetKeyState(VK_LCTRL) And KEY_MASK
            Case Else
                Res = GetKeyState(vbKeyControl) And KEY_MASK
        End Select
        IsControlKeyDown = CBool(Res)
    End Function
    
    
    Public Function IsShiftKeyDown(Optional LeftOrRightKey As Long = 3) As Boolean
        Dim Res As Long
        Select Case LeftOrRightKey
            Case LeftKey, RightKey
                Res = GetKeyState(VK_LSHIFT) And KEY_MASK
            Case Else
                Res = GetKeyState(vbKeyShift) And KEY_MASK
        End Select
        IsShiftKeyDown = CBool(Res)
    End Function
    The above functions have been borrowed from Chip Pearson and modified for this project.
    Attached Files Attached Files

Page 1 of 2 12 LastLast

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •