VBA data table in separate sheet to record data every time the primary sheet is used to assign points to people

[Jalize]

Hello

Every day, the children in a school hostel lose or gain points, based on their behaviour. I have a worksheet with command buttons that add or deduct points from each child's total, along with a date-stamp when it happens. The sheet can be used several times a day. Every time when it is used, I want to record the number of points added or deducted per child, the reason for losing or gaining those points, the person who added/deducted and the date stamp.

I want to avoid multiple tabs and actions. The users are not very literate in Excel and it must be quick and easy to assign points.
Is it possible to have one data table that updates every time the sheet is used?

My thinking is:
1) Use the sheet buttons to add or deduct points and capture the reasons in column D
2) Use a command button to ADD the data to the data table on a different sheet (person; number of points gained/lost; date-stamp and reasons)
3) Use a command button to RESET the sheet to clear it of all data, except the running total

The data table will probably be huge, because it will contain data for 114 children on 365 days, with numerous entries per day. Can this be done in a practical, user-friendly manner that will allow me to give parents feedback on why their children lost or gained points? If so, how must I approach it from a VBA perspective?

This is my VBA button code:

Private Sub CommandButton1_Click()

Dim Points As Integer

'check that selection is a single cell in column A and that B contains a name
'otherwise ignore
If Selection.Cells.Count > 1 Then Exit Sub
If Not Selection.Column = 1 Then Exit Sub
If Not Selection.Offset(0, 1) > "" Then Exit Sub
'add / deduct points
Selection = Selection + 5
'put date in column C
Selection.Offset(0, 2) = Now()

End Sub

Please help!

 

[Snakehips]

@Jalize In some ways, this question is a bit too loosely defined for anybody tho give you meaningful code.
In short, yes you can easily create a single data table that can be updated with a fresh row containing the latest input.
However, the input method / sequence will be governed by workplace practicalities and needs, known only to you.
If those can be clarified then we would have a better idea if and how to manipulate the input data.
Similarly, your reporting needs may well influence how best you manage and present the data table.

 

[Jalize]

Okay, let's try again...

My workbook has 2 sheets. Sheet1 is named "Points" and has 8 command buttons that add/deduct points from a child's total points in column A. This sheet can be used numerous times per day and captures the date and time with each use. After each use, I want to SAVE the data in the "Table" sheet, using a command button, then RESET the sheet to delete all existing data in columns C,D and E, from row 14, downwards (below the headings).

The "Table" sheet has the same headings as the "Points" sheet, but with 1 extra column, to capture the number of points awarded/deducted each time the sheet is used. I am having trouble with the following:
# If there is a date in column C, I want to copy cells A to E of that row and paste them below the previous row of data in the "Table" sheet. Below is my current code, but it runs an error at "Cells(nextRow, 1).Select". I've tried a number of different ways to copy and paste the data, but I haven't succeeded yet.

Private Sub CommandButton9_Click()

Dim iCell As Range

For Each iCell In Range("C14:C250").Cells
iCell.Offset(-2, 2).Copy
Sheets("Table").Select
nextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(nextRow, 1).Select
ActiveSheet.Paste
Sheets("Points").Select

Next iCell

End Sub

# What code do I use to capture the number of points awarded/deducted with the command buttons that were clicked? That number must populate column F for each row of data pasted in the table.

# Is it possible to automatically populate column E of the "Points" sheet with the name of the person using the sheet? If I have a list of Users and their IP addresses, is there code to identify the current User's IP address and return the name of the user in Column E?

 

[Jalize]

@Jalize In some ways, this question is a bit too loosely defined for anybody tho give you meaningful code.
In short, yes you can easily create a single data table that can be updated with a fresh row containing the latest input.
However, the input method / sequence will be governed by workplace practicalities and needs, known only to you.
If those can be clarified then we would have a better idea if and how to manipulate the input data.
Similarly, your reporting needs may well influence how best you manage and present the data table.

My Employer unfortunately blocks the Xl2BB add-in.

 

[Snakehips]

@Jalize
Is the Points sheet essentially just the Input page?
If you are logging each and every input on the Table sheet, do you really need more info on the Points sheet other than current points total and name?
Is your list of Reasons shown in the pics complete or might there be other reasons?

 

[Jalize]

Yes, "Points" is an input sheet. The running total and names will be locked to changes. They are fixed.
The list of reasons is not comprehensive. It's only a guideline for the most common behaviours. I considered a drop-down list, but I think it's best just to stick to a text field.
I'll manage the table with filters.

 

[Jalize]

With the help of #Snakehips I got my worksheet to do what I want! This is the code that worked:

Sub Allocate(Points As Integer)

'Ignore if not single cell selected in C, beyond row 14, withD not blank

If Not Selection.Column = 3 Then Exit Sub
If Not Selection.Row >= 14 Then Exit Sub
If Not Selection.Offset(0, 1) > "" Then Exit Sub

'Otherwise

Selection = Selection + Points  'Adjust points total

'Add entry to a listing in sheet 'Table'
    With Sheets("Table")
        'Find next available row in Table
            r = .Range("A" & Rows.Count).End(xlUp).Row + 1
        
        'Enter the input to columns A:E
            Selection.Offset(0, -2).Resize(1, 5).Copy Destination:=.Range("A" & r)
         'enter the points in F
             .Range("F" & r) = Points
             .Range("E" & r) = Now()
                      
    End With
    
     '**** Clear the entry detail in points sheet
    Selection.Offset(0, -2).Resize(1, 2).ClearContents
    
End Sub
Sub Minus_1()

Call Allocate(-1)

End Sub
Sub Minus_2()

Call Allocate(-2)

End Sub
Sub Minus_3()

Call Allocate(-3)

End Sub

 

[SonofBelial]

Here's my solution...

1. Create a separate sheet to store the data table. Let's name this sheet "DataTableSheet".
2. Modify your VBA code to include the following functions: `AddDataEntry`, `ResetSheet`, and `UpdatePoints`.
3. Update the `CommandButton1_Click()` subroutine to call the appropriate functions.
4. Add new command buttons for resetting the sheet and adding data to the data table.

Here's an updated version of your VBA code:

Private Sub CommandButton1_Click()

    ' Update points for the selected child
    UpdatePoints 5

End Sub

Private Sub AddDataEntry_Click()

    ' Add the data entry to the data table
    AddDataEntry
    
    ' Reset the sheet after adding the data entry
    ResetSheet

End Sub

Sub UpdatePoints(Points As Integer)

    ' Check that selection is a single cell in column A and that B contains a name
    If Selection.Cells.Count > 1 Then Exit Sub
    If Not Selection.Column = 1 Then Exit Sub
    If Not Selection.Offset(0, 1) > "" Then Exit Sub
    
    ' Add / deduct points
    Selection = Selection + Points
    
    ' Put date in column C
    Selection.Offset(0, 2) = Now()

End Sub

Sub AddDataEntry()

    Dim DataTable As Worksheet
    Set DataTable = ThisWorkbook.Sheets("DataTableSheet")
    Dim DataRow As Long
    
    ' Find the next empty row in the data table
    DataRow = DataTable.Cells(Rows.Count, 1).End(xlUp).Row + 1
    
    ' Copy person, number of points gained/lost, date-stamp, and reason to the data table
    DataTable.Cells(DataRow, 1) = Selection.Offset(0, 1)
    DataTable.Cells(DataRow, 2) = Selection
    DataTable.Cells(DataRow, 3) = Selection.Offset(0, 2)
    DataTable.Cells(DataRow, 4) = Selection.Offset(0, 3)

End Sub

Sub ResetSheet()

    ' Clear data in columns B, C, and D
    Range("B1:B114").ClearContents
    Range("C1:C114").ClearContents
    Range("D1:D114").ClearContents

End Sub

This updated code adds new subroutines and modifies the `CommandButton1_Click` subroutine. The `UpdatePoints` subroutine is now a standalone function that accepts a parameter for the points to be added/deducted. This will make it easier to modify the code later if needed.

Two new command buttons are added: one for adding the data entry (with its click event `AddDataEntry_Click`) and one for resetting the sheet (`ResetSheet`). The new `AddDataEntry_Click()` subroutine handles adding a new row to the data table and resetting the sheet after the entry is added.

With this setup, you can use the command buttons on your worksheet to easily add or deduct points, add data entries to the data table, and reset the sheet with minimal complexity. This should make it user-friendly and easy for your users to work with the sheet.

 

[SonofBelial]

With the help of #Snakehips I got my worksheet to do what I want! This is the code that worked:

Sub Allocate(Points As Integer)

'Ignore if not single cell selected in C, beyond row 14, withD not blank

If Not Selection.Column = 3 Then Exit Sub
If Not Selection.Row >= 14 Then Exit Sub
If Not Selection.Offset(0, 1) > "" Then Exit Sub

'Otherwise

Selection = Selection + Points  'Adjust points total

'Add entry to a listing in sheet 'Table'
    With Sheets("Table")
        'Find next available row in Table
            r = .Range("A" & Rows.Count).End(xlUp).Row + 1
       
        'Enter the input to columns A:E
            Selection.Offset(0, -2).Resize(1, 5).Copy Destination:=.Range("A" & r)
         'enter the points in F
             .Range("F" & r) = Points
             .Range("E" & r) = Now()
                     
    End With
   
     '**** Clear the entry detail in points sheet
    Selection.Offset(0, -2).Resize(1, 2).ClearContents
   
End Sub
Sub Minus_1()

Call Allocate(-1)

End Sub
Sub Minus_2()

Call Allocate(-2)

End Sub
Sub Minus_3()

Call Allocate(-3)

End Sub

This approach would actually make it easier to add more ways to allocate points in the future.

I think the code provided by SnakeHips needs slight changes in variable declaration and initialization to work correctly though. I added the line "Dim r As Long" and made slight adjustments in the comments. Here's the modified version:

Sub Allocate(Points As Integer)

    ' Ignore if not a single cell selected in C, beyond row 14, or if column D is not blank
    If Not Selection.Column = 3 Then Exit Sub
    If Not Selection.Row >= 14 Then Exit Sub
    If Not Selection.Offset(0, 1) > "" Then Exit Sub

    ' Otherwise, adjust the points total
    Selection = Selection + Points

    ' Add entry to a listing in sheet "Table"
    With Sheets("Table")
        ' Find the next available row in Table
        Dim r As Long
        r = .Range("A" & Rows.Count).End(xlUp).Row + 1

        ' Enter the input to columns A:E
        Selection.Offset(0, -2).Resize(1, 5).Copy Destination:=.Range("A" & r)
        
        ' Enter the points in F
        .Range("F" & r) = Points
        .Range("E" & r) = Now()
    End With

    ' Clear the entry detail in points sheet
    Selection.Offset(0, -2).Resize(1, 2).ClearContents

End Sub

Sub Minus_1()

    Call Allocate(-1)

End Sub

Sub Minus_2()

    Call Allocate(-2)

End Sub

Sub Minus_3()

    Call Allocate(-3)

End Sub

This updated code should work correctly as long as the sheet named "Table" exists in your workbook. This method reduces the amount of code needed to allocate points and provides a more efficient approach to handling multiple point allocations.