How do I combine two codes into one ?

[palaeontology]

I have a spreadsheet that uses two codes on Sheet 3. They are both Worksheet_Change Events and obviously do two different things, but both rely on the contents of the same cell ranges.

I'm new to vba (and VERY bad at it) so am making these codes from watching youtube instructionals etc, but I've come to realise that if I use 'Option Explicit' I need to combine both codes into one code ... or at least I think this is what I need to do.

Here is one code ...

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

Here is the other code ....

Private Sub Worksheet_Change(ByVal Target As Range)

Sheet3.Unprotect "SeatChoice"

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

Sheet3.Protect "SeatChoice"

End Sub

I currently have them in the same Sheet 3 coding window, but the second code (which is supposed to lock a cell once it has been edited) seems to be preventing the first code (which is supposed to see if a cell has anything in it, and if so, change the fill colour of a corresponding small circle from white to red) from working properly.

In the absence of the second code (if I remove it from the coding window) the first code successfully changes the fill colour of the small circle from white to red if the corresponding cell has something in it, and successfully changes it back if I remove the contents of that same cell. However, as soon as I have the second code in the coding window as well, the first code only works once, and doesn't recognise if I make further changes to the corresponding cell.

Can someone please advise me how I combine the two codes so that the second code doesn't impact on the first code ?

Kindest regards,

Chris Jamieson

 

[OaklandJim]

Unfortunately I cannot quite understand what the code is supposed to do. Maybe respost the code with comments about what is happening.

But first, there may ONLY be ONE CHANGE EVENT per sheet. So you need to include the two "actions" so they are both in the one change event. This is what it might look like (logic is probably wrong though).

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

'Code to change shape color.

     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

'           Are you trying to determine the name of a shape in/over the cell specified? 
            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

'  Code to lock or unlock cell. 

'  Need to refer to the worksheet like this. Or, is it activesheet that you want to affect?
   Worksheets("Sheet3").Unprotect "SeatChoice"

'Note that Target may include more than one cell!
'Do you want the upperleftmost cell?
'If so try IsEmpty(Target.Cells(1)). Otherwise IsEmpty looks in all cells in Target.

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

    Worksheets("Sheet3").Protect "SeatChoice"

 End Sub

Consider posting a portion of the worksheet in question using Mr Excel's excellent XL2BB addin. See XL2BB web page.