coding ActiveX Control Text Boxes to individually lock after edit

[palaeontology]

I have a worksheet (Sheet1) with an image of a round dining table. The purpose of this worksheet is to allow students to choose which seat they would like to occupy at an upcoming school Formal (dinner/dance).

Surrounding the perimeter of the round table (image) I have 8 ActiveX Control Text Boxes ... (TextBox1 to TextBox8) ... representing 8 dining chairs

Above each TextBox is an ActiveX Command Button, which when pressed, saves the worksheet (but does not exit the worksheet. For example, above TextBox1 is CommandButton1, above TextBox2 is CommandButton2, etc etc.

Currently each text box is blank and waiting to have a student enter their name.

I would like to code the CommandButtons to only allow one student name to be entered into its 'companion' TextBox and after that name is entered, the TextBox is locked to any further attempt by a student to change whatever name was first entered into it. I would, however, like the spreadsheet owner to be able to edit the Textboxes if changes need to be made ... but only the spreadsheet owner.

Is this possible ?

I've done readings in the Forum around 'locking cells after edit', but have found nothing about 'locking TextBoxes after edit'.

Am I going about this an efficient way, or is there a better way to do this ?

 

[palaeontology]

OK, change of approach.

I now have the following layout ...

I have tried the following code to lock a cell once a name has been entered into it, but I must be doing something wrong, as the cells aren't locking.

Private Sub Worksheet_Change(ByVal Target As Range)

Sheet2.Unprotect "SeatChoice"

If VBA.IsEmpty(Target) Then
    Target.Locked = False
    Else
    Target.Locked = True
End If

Sheet2.Protect "SeatChoice"

End Sub

The videos I watched to make this code suggested all the cells in the sheet need to be set to 'unlocked' in the cell formatting in the first place, which I did, and the code wasn't working for me.

I tried it with all the cells locked, again no good.

I tried with unlocking only the cells I wanted the students to be able to enter into (eg: C32:C41 and F32:F41) but still no good, so I'm not sure what I'm doing wrong.

Once I figure out how to adjust my code to work, I then wish to have a tiny circle (sitting on top of each seat) that is coded to turn from no fill and no line to red fill and red line when that particular seat has been taken. In the image above, I have placed an example of this on seat 4 at Table A indicating that the student called Chris Jamieson has entered his name in cell C35, so the corresponding tiny circle (called Oval 4) will change from unseeable to red.

Can anyone suggest how I should adjust my current code (to lock a cell once edited) and can anyone help me with coding the ovals to do what I've indicated above ? There will be 220 ovals in total ... I'm happy to use a code that works for Oval 4 (relating to cell C35) and make 219 copies of it and adjusting each of those as necessary.

I appreciate any help given,

very kindest regards,

Chris Jamieson

 

[palaeontology]

This is what I wrote for the small little red circle sitting above seat 4 at Table A to go from invisible to red if its corresponding cell (C35) has text in it ....

Private Sub Worksheet_Change(ByVal Target As Range)

    If Intersect(Target, Range("C35")) Is Nothing Then Exit Sub
    If IsText(Target.Text) Then
        If Target.Text <> "" Then
            ActiveSheet.Shapes("Oval 5").Fill.ForeColor.RGB = vbRed
        Else
            ActiveSheet.Shapes("Oval 5").Fill.ForeColor.RGB = vbWhite
        End If
    End If
End Sub

But I obviously have written it incorrectly, as it too is not working

 

[palaeontology]

Ok, changed my code for the red circle shape to ...

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
     Dim myShape As Shape
     Dim myCells As Range
     Dim intRange As Range
     Dim intCell As Range
     Dim shpName As String
   
     Set myCells = Range("C35") ' These are the "Target" cells
     Set intRange = Intersect(myCells, Target)
   
     If (Not intRange Is Nothing) Then ' This means that that changed cells intersect our selected cells
        For Each intCell In intRange.Cells
            shpName = intCell.Address(False, False) ' Shape name same as cell address
            Select Case intCell.Value
            Case ""
                ActiveSheet.Shapes(shpName).Fill.ForeColor.RGB = RGB(255, 255, 255)
            Case Else
                ActiveSheet.Shapes(shpName).Fill.ForeColor.RGB = RGB(255, 0, 0)
            End Select
        Next intCell
    End If
 End Sub

and it now works.

I do still need to fix my code for my original issue though ... a code where the cell locks once it has been edited (see my second post).