79165178

Date: 2024-11-07 06:03:03
Score: 0.5
Natty:
Report link

I've worked some more in the class and was able to solve 90%: colouring same preference red + hopping out

Here is the class code:

Option Explicit

Public WithEvents CmdEvents As MSForms.ToggleButton

Private Sub CmdEvents_Click()

    'if Clicking off, do nothing
    'set backcolor to off
    If CmdEvents.Value = False Then
        CmdEvents.BackColor = vbButtonFace
        GoTo EndNothing
        Else
        CmdEvents.BackColor = RGB(0, 128, 64)
    End If
    'MsgBox "mpp: " & Left(CmdEvents.Name, 1) & vbCrLf & "i: " & Mid(CmdEvents.Name, 2, 1) ' reads out mpp and i
    Dim i As Long
    Dim mpp         As Long
    mpp = Left(CmdEvents.Name, 1)
    Dim ctl As Control
    Dim nv As Long
    nv = 0
    Dim trb As Long
'    Dim j As Long
        
    For i = 1 To Sheets(1).Cells(11 + mpp, 5).Value
        If Order.Controls(Left(CmdEvents.Name, 2) & i).Value And i <> Right(CmdEvents.Name, 1) Then
            nv = Order.Controls(Left(CmdEvents.Name, 2) & i).Name
            Order.Controls(Left(CmdEvents.Name, 2) & i).Value = False
        End If
    Next i

    'Colour Red if same preference
    For Each ctl In Order.Controls
        If Left(ctl.Name, 1) = mpp Then 'if control is a TB button
            If Left(ctl.Name, 1) = Left(CmdEvents.Name, 1) And Right(ctl.Name, 1) = Right(CmdEvents.Name, 1) And ctl.Value = True And CmdEvents.Value = True And ctl.Name <> CmdEvents.Name Then
                ctl.BackColor = RGB(120, 105, 2) 'red
                CmdEvents.BackColor = RGB(120, 105, 2) 'red
                Else
                'reset green colour
                If Left(ctl.Name, 1) = Left(CmdEvents.Name, 1) And Right(ctl.Name, 1) = Right(CmdEvents.Name, 1) And ctl.Value = True And ctl.Name <> CmdEvents.Name Then
                   'only if not two buttons are pressed in column
                   'need to change "old" column colour as well
'                   For j = 1 To Sheets(1).Cells(11 + mpp, 5).Value
                    trb = 0
                    For i = 1 To Sheets(1).Cells(11 + mpp, 5).Value
                         If Order.Controls(Left(CmdEvents.Name, 1) & i & Right(CmdEvents.Name, 1)).Value Then 'j
                             trb = trb + 1
                         End If
                     Next i
                     MsgBox trb
                    If trb = 1 Then
                         ctl.BackColor = RGB(0, 128, 64) 'green
                    End If
'                  Next j
                End If
            End If
        End If
    Next ctl
    
EndNothing:
End Sub

I also added some colour code and next page in multipage to Order Initialize:

For mpp = 1 To 2 'added version for alternative date
 ' the same
TB.Name = mpp & i & j 'altered for second "date" to work
 ' the same
If TB.Caption = i Then
                        TB.Value = True
                        TB.BackColor = RGB(0, 128, 64) 'added to give green background'
 ' the same
Next mpp
End Sub

My only problem now is that if you click of "7" now (and make it right again), the other 7 stays red: "7" stays red although correct

Reasons:
  • Probably link only (1):
  • Long answer (-1):
  • Has code block (-0.5):
  • Self-answer (0.5):
  • Low reputation (0.5):
Posted by: Chris Peh