Coloring multiple cells with option buttons

[Nicolas Mous]

Hello all,

I have made a function in VBA which allows a user to choose an option (with the option buttons), the chosen option will color the cell its linked to. There are 4 options 1 = green 2 = orange 3 = red and 4 = white/ no color. The option buttons (4 linked to eachotter) are put in a cell for example A1, the cell its then linked to (which it colors) is B1 and A2 is linked to B2 and so on so on.
The VBA code i made with my, poorly VBA skills is:

Sub Optionbutton1_click()
Range("B2").Interior.ColorIndex = 4
End Sub
Sub Optionbutton2_click()
Range("B2").Interior.ColorIndex = 45
End Sub
Sub Optionbutton3_click()
Range("B2").Interior.ColorIndex = 3
End Sub
Sub OptionbuttonX1_click()
Range("B2").Interior.ColorIndex = 2
End Sub
Sub Optionbutton4_click()
Range("B3").Interior.ColorIndex = 4
End Sub
Sub Optionbutton5_click()
Range("B3").Interior.ColorIndex = 45
End Sub
Sub Optionbutton6_click()
Range("B3").Interior.ColorIndex = 3
End Sub
Sub OptionbuttonX2_click()
Range("B3").Interior.ColorIndex = 2
End Sub

This code is working excellent but there is one downside to it. Since im not using 2 cells to color in (like in the code example) it are more like 90 cells +/- (option button total with 90 cells to color in = 90 x 4 buttons). This means a lot of copy pasting and changing 1. every name of every option button 2. every cell number which needs to be colored 3. linking every seperate macro to the right option button. So its really a lot lot lot lot of work with so many cells to be colored.

My question is, can i make an easier code (like 1) which will do the same but doesnt require this much work?

Thx in advance!

[MickG]

If you used the code below, you just need to "Right" click any cell in Column "B" and it will change colour.
Each time you "Right" click the cell colour changes.

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
Application.EnableEvents = False
    If Target.Column = 2 Then
        With Target.Interior
            Select Case .ColorIndex
                Case 2: .ColorIndex = 45
                Case 45: .ColorIndex = 4
                Case 4: .ColorIndex = 3
                Case 3: .ColorIndex = 2
            End Select
        End With
End If
Application.EnableEvents = True
End Sub

[Nicolas Mous]

Thank you MickG, but the point is that there has to be a option button involved. This makes it for the users more visual, they can see the option button (=Action done, overdue, has to be done soon or not active) and also the color linked to it = green/orange/red, non-colored.

[MickG]

If you are saying for each cell you have 4 option Buttons (I assume with there Caption title showing one of 4 colours), then you could write a Class module that will detect which button you have selected and from what cell , and then colour the column "B" cell accordingly.

[Nicolas Mous]

If you are saying for each cell you have 4 option Buttons (I assume with there Caption title showing one of 4 colours), then you could write a Class module that will detect which button you have selected and from what cell , and then colour the column "B" cell accordingly.

It looks like that could do the trick indeed, but dont forget im not a genius with VBA and i really got no clue how to make a Class module, let alone program it

[MickG]

Try this:-
This is not too complicated if you take it a step at a time.
It is the assumed that the related sheet has 4 OptionButtons in each cell in column "A" . The 4 buttons have Captions:- Green, Orange,Red and Blank.
You can have as many cells in Column "A" with "Optionbuttons" as you like..
Step (1)
Right Click the sheet Tab and from the "Dropdown" select "View Code".
VBWindow appears.
Copy and Paste the code below into the VbWindow at the very top of the Window , insuring you don't end up with two "Option Explicit"s at the top..of the window.

Option Explicit
Dim myCbs() As clsOpButton
Private Sub Worksheet_Activate()
Dim pointer As Long
  Dim oneControl As OLEObject
    ReDim myCbs(1 To ActiveSheet.OLEObjects.Count)
     For Each oneControl In ActiveSheet.OLEObjects
       If TypeName(oneControl.Object) = "OptionButton" Then
            pointer = pointer + 1
            Set myCbs(pointer) = New clsOpButton
            Set myCbs(pointer).oPton = oneControl.Object
        End If
    Next oneControl
    ReDim Preserve myCbs(1 To pointer)
End Sub

Step (2)
With the VBwindow still open, look on the left hand side, where there should be the "Project Window" if it is not there click "Ctrl+R"
Right click somwhere in that "Project Window." and from the "DropDown" select "Insert" then "Class Module". New Vb window appears and a new Module title in the "Project Window" showing a "Class1"
Paste the code below into that VBWindow.

Option Explicit
Public WithEvents oPton As MSForms.OptionButton
Private Sub opton_Click()
 With oPton.TopLeftCell.Offset(, 1).Interior
    Select Case oPton.Caption
        Case "Green": .ColorIndex = 4
        Case "Orange": .ColorIndex = 45
        Case "Red": .ColorIndex = 3
        Case "Blank": .ColorIndex = 2
    End Select
  End With
End Sub

In the "Project Window" Click on the Module "Class1", then click "F4", The "Class1" properties window appears. Change the "Name" in the window from "Class1" to "clsOpButton" (No Commas)
Close the Vb windows.
To collect all the OptionButton Information and run the first bit of code you need to select another sheet, then reselect the "OptionButton" sheet.
You should now be able to Click any of the "Option Buttons" and the Column"B" cell will change colour accordingly.
Good Luck
Regrds Mick

[Nicolas Mous]

Thx alot Mick but is till got one problem when coying it.

When i go to another sheet and go back to the first sheet to activate the code i get an error messge in this line:

Option Explicit
Dim myCbs() As clsOpButton
Private Sub Worksheet_Activate()
Dim pointer As Long
  Dim oneControl As OLEObject
    ReDim myCbs(1 To ActiveSheet.OLEObjects.Count)
     For Each oneControl In ActiveSheet.OLEObjects
       If TypeName(oneControl.Object) = "OptionButton" Then
            pointer = pointer + 1
            Set myCbs(pointer) = New clsOpButton
            Set myCbs(pointer).oPton = oneControl.Object
        End If
    Next oneControl
    ReDim Preserve myCbs(1 To pointer)
End Sub

it says that the subscript is out of reach or something (translated it)

[martindwilson]

you could of course just use conditional formatting

[MickG]

I imagine that you either have no "OptionButtons"on the sheet or your "OptionButtons" are "Forms Control" Buttons. They need to be "ActiveX" OptionButtons.

[Nicolas Mous]

I imagine that you either have no "OptionButtons"on the sheet or your "OptionButtons" are "Forms Control" Buttons. They need to be "ActiveX" OptionButtons.

True, my option buttons were forms control buttons. changed the first four to ActiveX but still doesnt seem to work. Deleted all my other macro's and option buttons but still it doesnt work with only the 4 activex buttons. I uploaded the document to make it perhaps a bit clearer to you!

(The error message is gone tho)

Thx alot anyway for getting me this far

The file: test outputs.xlsm

[MickG]

NO FILE ????
Have you named the OptionButton Captions as per Class Code ????

[Nicolas Mous]

Hmm that depends on how i do that hm in my post i can see the file? forgot it in my first post but editted it on 4.57PM!