Advertisement
YasserKhalil2019

T4087_Record Absent Students To Multiple Sheets

Oct 10th, 2019
234
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 1.67 KB | None | 0 0
  1. https://excel-egy.com/forum/t4087
  2. ---------------------------------
  3.  
  4. Sub Record_Absent_Students_To_Multiple_Sheets()
  5. Dim x, y, ws As Worksheet, sh As Worksheet, c As Range, s As String, cnt As Long
  6.  
  7. Application.ScreenUpdating = False
  8. Set ws = ThisWorkbook.Worksheets(1)
  9.  
  10. For Each c In ws.Range("A7:A" & ws.Cells(Rows.Count, 1).End(xlUp).Row)
  11. If InStr(c.Offset(, 2).Value, "أولى") Then
  12. Set sh = ThisWorkbook.Worksheets(3)
  13. ElseIf InStr(c.Offset(, 2).Value, "ثانيه") Then
  14. Set sh = ThisWorkbook.Worksheets(4)
  15. ElseIf InStr(c.Offset(, 2).Value, "ثالثه") Then
  16. Set sh = ThisWorkbook.Worksheets(5)
  17. Else
  18. MsgBox "Review The Student Grade At Row " & c.Row, vbExclamation: GoTo Skipper
  19. End If
  20.  
  21. x = Application.Match(Val(c.Value), sh.Columns(1), 0)
  22.  
  23. If Not IsError(x) Then
  24. y = Application.Match(CLng(Date), sh.Rows(7), 0)
  25. If Not IsError(y) Then
  26. sh.Cells(x, y).Value = "غ"
  27. cnt = cnt + 1
  28. End If
  29. Else
  30. s = s & IIf(s = "", "", " | ") & c.Value
  31. End If
  32. Skipper:
  33. Next c
  34.  
  35. If cnt > 0 Then
  36. MsgBox "The Students That Have Been Recorded = " & cnt, vbInformation
  37. If s <> "" Then MsgBox "Students That Have Not Been Recorded " & vbNewLine & s, vbExclamation
  38. Else
  39. MsgBox "No Students Recorded At All", vbExclamation
  40. End If
  41. Application.ScreenUpdating = True
  42. End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement