hi help me for my project

[pasawhy666]

hi i'm newbie here..

anyone help me for my project regarding code in vba

i need to make attendance using vba code..

10% grade..



hope you can help me! tnx

[SamT]

We need a lot more information than just that.

[Kenneth Hobs]

Welcome to the forum!

Post a simplified workbook attachment rather than a private message (PM) to a forum member with a link to a shared server's file. As Sam said, more detail is needed unless you clearly detailed what you need in the workbook when you post it. 10% grade is unclear. If it is a whole project, help is less likely. If you need help with a project, break it down into simplified parts in separate threads. You can include links to other posts if it might help with another part.

[Aflatoon]

Cross-posted (with file link) here: http://www.mrexcel.com/forum/excel-q...ml#post3598992

[pasawhy666]

here my project

see the attachment file

i need a attendance record that automatically compute the attendance and automatically
appear in the First Grading. and i need a total of absent..

im sorry but im not familiarize in vba code!! im apologize hope you understand tnx

[Kenneth Hobs]

I used to teach myself. I don't see that VBA is needed at all. Formulas should suffice. I don't know what "First Grading" means. If that the percent of "P" or the count of "P"? The opposite of that is the count of "A" so just use =CountIf() for that. e.g. =COUNTIF(AO12:BC12,"=A"). Now that you know the count, you can divide by the total. e.g. =COUNTIF(AO12:BC12,"=A")/COLUMNS(AO12:BC12)

Obviously, multiply by 100 to get a percent or format the cell to percentage.

[Aussiebear]

Wonderful workbook.... but totally useless to anyone other than yourself. There is no apparent relationship in the data provided to assist us in how you built the workbook. Most of the data ( if not all of it) is based on manual input, the rules of which we cannot see nor comprehend nor have you indicated how the values are obtained.. And given the very limited explanation of what you are seeking to do, well I would grade your attempt here as "Please re-sit the course".

You say you need an attendance record yet this value is currently in Column V for every student. As every student has a 100% participation rate ( as per your data, and again, a single value per student, so how is a mathematical formula to be built upon this value), why would you seek to know the absent rate?

[pasawhy666]

Private Sub Worksheet_Change(ByVal Target As Range)    Dim Changed As Range
    Set Changed = Range("F:F")
        If Intersect(Target, Changed) = "P" Then
        ElseIf Intersect(Target, Changed) = "A" Then
        ElseIf Intersect(Target, Changed) = "E" Then
        ElseIf Intersect(Target, Changed) = "" Then
        Else
            MsgBox "MAY MALI"
        End If
End Sub

whats wrong this code!!

the error is ambiguous name detected:worksheet_change

[Kenneth Hobs]

Intersect() returns a range. You have it setup to trigger based on changing the final grade manually. The target intersecting with column F then would never be any letter value.

Here is an example using Intersect.

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim r As Range, rr As Range, cell As Range
  
  Set rr = Range("A5", Range("A" & Rows.Count))
  Set r = Intersect(Target, rr)
  If r Is Nothing Then Exit Sub
  If r.Row < 5 Then Exit Sub
  
  Application.EnableEvents = False
  For Each cell In r
    If cell.Column = 1 And cell.Row >= 5 Then
      If Len(cell.Value) = 5 Then
           Range("F" & cell.Row).Value = Left(cell.Value, 3)
           Range("G" & cell.Row).Value = Right(cell.Value, 1)
        Else
          Range("F" & cell.Row).Value = ""
          Range("G" & cell.Row).Value = ""
      End If
    End If
  Next cell
  Application.EnableEvents = True
End Sub

[pasawhy666]

same error what are the problem

[Kenneth Hobs]

What is the code where you fixed problems?

[pasawhy666]

Private Sub Worksheet_Change(ByVal Target As Range) Dim Changed As Range
Set Changed = Range("F:F")
If Intersect(Target, Changed) = "Present" Then
ElseIf Intersect(Target, Changed) = "Absent" Then
ElseIf Intersect(Target, Changed) = "Excuse" Then
ElseIf Intersect(Target, Changed) = "" Then
Else
MsgBox "MAY MALI"
End If
End Sub


i think the problem is the "worksheet_change" ?

[pasawhy666]

Private Sub afdate_Click()    ActiveCell.Value = Date
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
Dim a
Dim Changed As Range
Set Changed = Range("L12:V51")
    If Not Intersect(Target, Changed) Is Nothing Then
        For a = 12 To 40 + 11
            'Exam %
            Cells(a, 23) = Cells(a, 12) / Cells(9, 12)
            'End Exam
            'Quiz %
            Cells(a, 24) = Cells(a, 13) / Cells(9, 13)
            Cells(a, 25) = Cells(a, 14) / Cells(9, 14)
            Cells(a, 26) = Cells(a, 15) / Cells(9, 15)
            Cells(a, 27) = Cells(a, 16) / Cells(9, 16)
            'End Quiz
            'SW&A %
            Cells(a, 28) = Cells(a, 17) / Cells(9, 17)
            Cells(a, 29) = Cells(a, 18) / Cells(9, 18)
            Cells(a, 30) = Cells(a, 19) / Cells(9, 19)
            Cells(a, 31) = Cells(a, 20) / Cells(9, 20)
            'End SW&A
            'Project %
            Cells(a, 32) = Cells(a, 21) / Cells(9, 21)
            'End Project
            'Participation %
            Cells(a, 33) = Cells(a, 22) / Cells(9, 22)
            'End P
            '///////////////////////////////////////////////////////////////////////////////
            'Final Quiz Grade
            Cells(a, 34) = (Cells(a, 24) + Cells(a, 25) + Cells(a, 26) + Cells(a, 27)) / 4
            'End FQG
            'Final S&A Grade
            Cells(a, 35) = (Cells(a, 28) + Cells(a, 29) + Cells(a, 30) + Cells(a, 31)) / 4
            'End S&AG
            'Final Participation
            Cells(a, 36) = Cells(a, 33)
            'End P
            'Final Project Grade
            Cells(a, 37) = Cells(a, 32)
            'End FPG
            'Final Exam Grade
            Cells(a, 39) = Cells(a, 23)
            'End FEG
            'First Grading Grade-----------Quiz Score-------------------------------S%A Score-------------------------------Participation-----------------------------Project----------------------------------Attendance--------------------------------Exam---------------
            Cells(a, 7) = ((Cells(a, 34) * 100) * Cells(11, 34)) + ((Cells(a, 35) * 100) * Cells(11, 35)) + ((Cells(a, 36) * 100) * Cells(11, 36)) + ((Cells(a, 37) * 100) * Cells(11, 37)) + ((Cells(a, 38) * 100) * Cells(11, 38)) + ((Cells(a, 39) * 100) * Cells(11, 39))
            'End FGG
            '***********Final Grade****************
            Cells(a, 6) = (Cells(a, 7) + Cells(a, 8) + Cells(a, 9) + Cells(a, 10)) / 4
            'End FG
        Next
    End If
Set Changed = Nothing
End Sub


this is the code..

[pasawhy666]

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Changed As Range
    Set Changed = Range("F:F")
        If Intersect(Target, Changed) = "Present" Then
        ElseIf Intersect(Target, Changed) = "Absent" Then
        ElseIf Intersect(Target, Changed) = "Excuse" Then
        ElseIf Intersect(Target, Changed) = "" Then
        Else
            MsgBox "MAY MALI"
        End If
End Sub

sir this is the code that has a problem the above code is running but when i input this code theres a problem

"ambiguous name detected:worksheet_change"

[Kenneth Hobs]

Your post #13 is the closest to something that might work. I would guess that just one value changed would be what you want to act on and not do a For() loop. Use the intersection range's Row number as the changed range would most likely be just one cell. If you know the row that was changed, you can use string concatenation to do what you need. Set the cell's formula in column "F" for that row using a formula method should be simple enough. Be sure that you disable events when you change a cell value in a event as I demonstrated.

[pasawhy666]

sir the post #13 was working correctly the post #14 was a problem i dont know why?

[Kenneth Hobs]

Was this not clear?

Intersect() returns a range.

What you are doing is like this:

If Range("A1:D15")="Absent"

Obviously, that may not make sense. You might luck out and the intersection range just be one cell and then count on the default property being the value. I don't like to code based on an assumption like that.

Post #13 needs some improvement as I explained.

I don't understand why you don't want to use formulas though. I could manually enter formulas and copy down in 2 or 3 minutes most likely. Of course a macro could do that for you if you are just needing some automation. The change event method seems like overkill to me. I guess change event would be fine if you need it to automatically enter the formulas for you. Even in that case, I would just make a macro and run it on a new row of data.

[Aflatoon]

You can only have one worksheet_change event routine. You need to combine your two into one.

[SamT]

Combined two subs into one. Compiles, but not otherwise tested.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim a
    Dim Changed As Range
    
    ''''Check Attendance
    Set Changed = Range("F:F")
    If Not Intersect(Target, Changed) Is Nothing Then

      Select Case UCase(Target.Value)
        Case "PRESENT"
          '
        Case "ABSENT"
          '
        Case "EXCUSE"
          '
        Case ""
          '
        Case Else
          MsgBox "MAY MALI"
      End Select

      Exit Sub
    End If

    ''''Set Grades
    Set Changed = Range("L12:V51")
    If Not Intersect(Target, Changed) Is Nothing Then

        For a = 12 To 40 + 11
             'Exam %
            Cells(a, 23) = Cells(a, 12) / Cells(9, 12)
             'End Exam
             'Quiz %
            Cells(a, 24) = Cells(a, 13) / Cells(9, 13)
            Cells(a, 25) = Cells(a, 14) / Cells(9, 14)
            Cells(a, 26) = Cells(a, 15) / Cells(9, 15)
            Cells(a, 27) = Cells(a, 16) / Cells(9, 16)
             'End Quiz
             'SW&A %
            Cells(a, 28) = Cells(a, 17) / Cells(9, 17)
            Cells(a, 29) = Cells(a, 18) / Cells(9, 18)
            Cells(a, 30) = Cells(a, 19) / Cells(9, 19)
            Cells(a, 31) = Cells(a, 20) / Cells(9, 20)
             'End SW&A
             'Project %
            Cells(a, 32) = Cells(a, 21) / Cells(9, 21)
             'End Project
             'Participation %
            Cells(a, 33) = Cells(a, 22) / Cells(9, 22)
             'End P
             '///////////////////////////////////////////////////////////////////////////////
             'Final Quiz Grade
            Cells(a, 34) = (Cells(a, 24) + Cells(a, 25) + Cells(a, 26) + Cells(a, 27)) / 4
             'End FQG
             'Final S&A Grade
            Cells(a, 35) = (Cells(a, 28) + Cells(a, 29) + Cells(a, 30) + Cells(a, 31)) / 4
             'End S&AG
             'Final Participation
            Cells(a, 36) = Cells(a, 33)
             'End P
             'Final Project Grade
            Cells(a, 37) = Cells(a, 32)
             'End FPG
             'Final Exam Grade
            Cells(a, 39) = Cells(a, 23)
             'End FEG
             'First Grading Grade-----------Quiz Score-------------------------------S%A Score-------------------------------Participation-----------------------------Project----------------------------------Attendance--------------------------------Exam---------------
            Cells(a, 7) = ((Cells(a, 34) * 100) * Cells(11, 34)) + ((Cells(a, 35) * 100) * Cells(11, 35)) + ((Cells(a, 36) * 100) * Cells(11, 36)) + ((Cells(a, 37) * 100) * Cells(11, 37)) + ((Cells(a, 38) * 100) * Cells(11, 38)) + ((Cells(a, 39) * 100) * Cells(11, 39))
             'End FGG
             '***********Final Grade****************
            Cells(a, 6) = (Cells(a, 7) + Cells(a, 8) + Cells(a, 9) + Cells(a, 10)) / 4
             'End FG
        Next

    End If
End Sub