Adding "buttons" to an attendance form.

[msann]

Hello, everyone.
I'm very new to VBA, so bare with me. We have an attendance form that we use where students scan their IDs to a spreadsheet and we click on buttons to mark them present (P), tardy (T), or first time in class (FTC). Since half of our students are still virtual, I would like to add two more buttons, one for remote asynchronous present (RAP) and one for first time in class - remote (FTC-R). I tried copying the code but I keep getting an error. Not sure what I am doing wrong. I tried to post my spreadsheet using XL2BB but the buttons were showing up.

Here is the code from the spreadsheet.

Sub MarkFTC()

Dim PeriodWS, IDS As Worksheet
Dim Period, CheckID, IDreverse, TardyAddress, FirstName, LastName As String
Dim TDay As Date
Dim dateCell, IDRange, IDReverseRange As Range
Dim i, j, lastRow, IDlastRow As Integer
Set IDS = Sheets("ID Scan")
TardyAddress = Selection.Address
Application.ScreenUpdating = False
TDay = Date


Period = IDS.Range("C1").Value
Set PeriodWS = Sheets(Period)
lastRow = PeriodWS.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
Set dateCell = PeriodWS.Range("1:1").Find(what:=TDay)
If Not dateCell Is Nothing Then
    For i = 2 To lastRow
        CheckID = PeriodWS.Range("D" & i).Value
       
        Set IDRange = IDS.Range(TardyAddress).Find(what:=CheckID)
       
        If Not IDRange Is Nothing Then
            If Not PeriodWS.Cells(i, dateCell.Column).Interior.Color = RGB(128, 128, 128) Then
            IDS.Cells(IDRange.Row, "D").Value = "Marked FTC"
            PeriodWS.Cells(i, dateCell.Column).Value = "FTC"
            PeriodWS.Cells(i, dateCell.Column).Interior.Color = RGB(146, 208, 80)
            End If
        End If
    Next
Else
    MsgBox "Date Not in Range"
End If
IDS.Range("C1").Clear
IDlastRow = IDS.Cells(Rows.Count, 1).End(xlUp).Row
For j = 1 To IDlastRow
IDreverse = IDS.Range("A" & j).Value
Set IDReverseRange = PeriodWS.Range("D:D").Find(what:=IDreverse)

If IDReverseRange Is Nothing Then
    IDS.Cells(j, 3).Value = "ID not in " & Period
    IDS.Cells(j, 3).Interior.Color = RGB(255, 0, 0)
ElseIf PeriodWS.Cells(IDReverseRange.Row, dateCell.Column).Interior.Color = RGB(128, 128, 128) Then
    IDS.Cells(j, 3).Value = "Schedule Change"
Else
    FirstName = PeriodWS.Range("B" & IDReverseRange.Row).Value
    LastName = PeriodWS.Range("A" & IDReverseRange.Row).Value
    IDS.Cells(j, 3).Value = LastName & ", " & FirstName


End If

Next
IDS.UsedRange.Columns.AutoFit
Application.ScreenUpdating = True
End Sub

----------------

Here is mine. But I keep getting errors. Any suggestions would be great. Thanks.

Private Sub Mark_RAP()
UserForm7.Show
End Sub

Sub MarkRAP()

Dim PeriodWS, IDS As Worksheet
Dim Perid, CheckID, IDreverse, TardyAddress, FirstName, LastName As String
Dim TDay As Date
Dim dateCell, IDRange, IDReverseRange As Range
Dim i, j, lastRow, IDlastRow As Integer
Set IDS = Sheets("ID Scan")
TardyAddress = Selection.Address
Application.ScreenUpdating = False
TDay = Date

Period = IDS.Range("C1").Value
Set PeriodWS = Sheets("ID Scan")
lastRow = PeriodWS.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
Set dateCell = PeriodWS.Range("1:1").Find(what:=TDay)
If Not dateCell Is Nothing Then
For i = 2 To lastRow
        CheckID = PeriodWS.Range("D" & i).Value
       
        Set IDRange = IDS.Range(TardyAddress).Find(what:=CheckID)
       
        If Not IDRange Is Nothing Then
            If Not PeriodWS.Cells(i, dateCell.Column).Interior.Color = RGB(128, 128, 128) Then
            IDS.Cells(IDRange.Row, "D").Value = "Marked RAP"
            PeriodWS.Cells(i, dateCell.Column).Value = "RAP"
            PeriodWS.Cells(i, dateCell.Column).Interior.Color = RGB(255, 153, 0)
            End If
        End If
    Next
Else
    MsgBox "Date Not in Range"
End If
IDS.Range("C1").Clear
IDlastRow = IDS.Cells(Rows.Count, 1).End(xlUp).Row
For j = 1 To IDlastRow
IDreverse = IDS.Range("A" & j).Value
Set IDReverseRange = PeriodWS.Range("D:D").Find(what:=IDreverse)

If IDReverseRange Is Nothing Then
    IDS.Cells(j, 3).Value = "ID not in " & Period
    IDS.Cells(j, 3).Interior.Color = RGB(255, 0, 0)
ElseIf PeriodWS.Cells(IDReverseRange.Row, dateCell.Column).Interior.Color = RGB(128, 128, 128) Then
    IDS.Cells(j, 3).Value = "Schedule Change"
Else
    FirstName = PeriodWS.Range("B" & IDReverseRange.Row).Value
    LastName = PeriodWS.Range("A" & IDReverseRange.Row).Value
    IDS.Cells(j, 3).Value = LastName & ", " & FirstName


End If

Next
IDS.UsedRange.Columns.AutoFit
Application.ScreenUpdating = True
End Sub

 

[msann]

Hello, everyone.
I'm very new to VBA, so bare with me. We have an attendance form that we use where students scan their IDs to a spreadsheet and we click on buttons to mark them present (P), tardy (T), or first time in class (FTC). Since half of our students are still virtual, I would like to add two more buttons, one for remote asynchronous present (RAP) and one for first time in class - remote (FTC-R). I tried copying the code but I keep getting an error. Not sure what I am doing wrong. I tried to post my spreadsheet using XL2BB but the buttons were showing up.

Sorry, buttons were NOT showing up.

_Attendance_092019.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M
1
2
3
4
5
6
7
8
9
10
11						Select the ID numbers before clicking
12						the buttons below to change the code.
13						Or manually change the Period tab.
14											This button is ONLY used the
15											first time you create the file
16
17
18
19
20
21						No Shows must be entered by hand!
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
ID Scan