Dynamically change the color of all labels on a worksheet

Below is the code I am attempting to make work to dynamically change the color of all labels on my worksheet. I get the error message "Object doesn't support this property or method".

I can use this code to change other properties of the label (ex. It's position). Is there a way to reference my labels dynamically in a different way? I do know you can substitute 'OLEObjects' for 'Shapes', (which seems to work better in some codes?), but it doesn't help in this case.

Dim Var As Integer
Var = Range("A4").Value
ActiveSheet.OLEObjects("Label" & Var).BackColor = RGB(151, 102, 155)

This is how I am currently solving the problem. But I worry that it is becoming a rather long and straining code as I add more labels.

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
If Not Sheet1.Range("a4") = 1 Then Label1.BackColor = RGB(51, 102, 255) Else Label1.BackColor = RGB(151, 102, 155)
If Not Sheet1.Range("a4") = 2 Then Label2.BackColor = RGB(51, 102, 255) Else Label2.BackColor = RGB(151, 102, 155)
If Not Sheet1.Range("a4") = 3 Then Label3.BackColor = RGB(51, 102, 255) Else Label3.BackColor = RGB(151, 102, 155)
If Not Sheet1.Range("a4") = 4 Then Label4.BackColor = RGB(51, 102, 255) Else Label4.BackColor = RGB(151, 102, 155)
If Not Sheet1.Range("a4") = 5 Then Label5.BackColor = RGB(51, 102, 255) Else Label5.BackColor = RGB(151, 102, 155)
If Not Sheet1.Range("a4") = 6 Then Label6.BackColor = RGB(51, 102, 255) Else Label6.BackColor = RGB(151, 102, 155)
If Not Sheet1.Range("a4") = 7 Then Label7.BackColor = RGB(51, 102, 255) Else Label7.BackColor = RGB(151, 102, 155)
If Not Sheet1.Range("a4") = 8 Then Label8.BackColor = RGB(51, 102, 255) Else Label8.BackColor = RGB(151, 102, 155)
If Not Sheet1.Range("a4") = 9 Then Label9.BackColor = RGB(51, 102, 255) Else Label9.BackColor = RGB(151, 102, 155)
If Not Sheet1.Range("a4") = 10 Then Label10.BackColor = RGB(51, 102, 255) Else Label10.BackColor = RGB(151, 102, 155)
End Sub

Hi there,

Try using the following code to overcome the immediate problem:

ActiveSheet.OLEObjects("Label" & Var).Object.BackColor = RGB(151, 102, 155)

Hope this helps - please let me know how you get on.

Regards,

Greg M

Thanks Greg, this solved my immediate problem!

My overall goal is to make the selected label one color and all other labels another color ever time a label is selected. I have a cell that stores the number of the selected label. I wouldn't turn down some advice if you had any tips.

Thanks again.

I decided on using this code:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Var As Integer
Dim Ctrl As OLEObject

Var = Range("A4").Value

    For Each Ctrl In ActiveSheet.OLEObjects
         If TypeName(Ctrl.Object) = "Label" And Not Ctrl.Object.BackColor = RGB(51, 102, 255) Then Ctrl.Object.BackColor = RGB(51, 102, 255)
    Next Ctrl

 ActiveSheet.OLEObjects("Label" & Var).Object.BackColor = RGB(151, 102, 155)

End Sub

It seems to work alright. I at least don't ever have to add any code to it after I add new labels. Any tips on making it faster would be appreciated!

Maybe something like this...

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Ctrl As OLEObject
    
    If Target.Address <> "$A$4" Then Exit Sub
    
    For Each Ctrl In Me.OLEObjects
         If TypeName(Ctrl.Object) = "Label" Then Ctrl.Object.BackColor = RGB(51, 102, 255)
    Next Ctrl
    
    On Error Resume Next
    Me.OLEObjects("Label" & Target.Value).Object.BackColor = RGB(151, 102, 155)
    On Error GoTo 0
End Sub

You'll notice that it exits the sub if the target cell is not A4. You'll also notice that error handling has been added, in case a number is entered that doesn't correspond with one of the labels.

Hope this helps!

Hi Domenic. The exit sub code greatly helps since it reduces the frequency that the code is executed. Thank you.

I don't need the error handling since a number is only entered into the cell corresponding to a label click event (according to the label number).

Thanks again!

That's great, I'm glad I could help.

Cheers!

Hi again,

Try using the attached code in order to reduce the execution time:

Sub HighlightSelectedLabel()

    Const sPREVIOUS_LABEL_CELL  As String = "A3"
    Const sCURRENT_LABEL_CELL   As String = "A4"
    Const sLABEL_PREFIX         As String = "Label"

    Dim lHighlightColour        As Long
    Dim iPreviousLabelNo        As Integer
    Dim iCurrentLabelNo         As Integer
    Dim lNormalColour           As Long
    Dim sLabelName              As String
    Dim ctl                     As OLEObject

    lHighlightColour = RGB(151, 102, 155)
    lNormalColour = RGB(51, 102, 255)

    With ActiveSheet

        iPreviousLabelNo = .Range(sPREVIOUS_LABEL_CELL).Value

        If iPreviousLabelNo <> 0 Then

              sLabelName = sLABEL_PREFIX & iPreviousLabelNo
              .OLEObjects(sLabelName).Object.BackColor = lNormalColour

        Else

'             This code will probably never be executed - it caters for the situation where (for some strange reason!)
'             the number of the previously-selected label has been deleted from the "Previous Label" cell
              For Each ctl In ActiveSheet.OLEObjects
                  If TypeName(ctl.Object) = sLABEL_PREFIX Then
                      ctl.Object.BackColor = lNormalColour
                  End If
              Next ctl

        End If

        iCurrentLabelNo = .Range(sCURRENT_LABEL_CELL).Value
        sLabelName = sLABEL_PREFIX & iCurrentLabelNo
        .OLEObjects(sLabelName).Object.BackColor = lHighlightColour

        .Range(sPREVIOUS_LABEL_CELL).Value = iCurrentLabelNo

    End With

End Sub

It works by storing the number of the previously selected (highlighted) Label and therefore needs to reset the background colour of only that label whenever a new label is selected.

I don't have access to all of your code, but it might be possible to reset the previously-selected label (whose number is stored in Cell A4) BEFORE you update that cell with the number of the newly-selected label.

Hope this helps - please let me know how you get on.

Regards,

Greg M

Below is the solution I came up with with great thanks to both of you! Gregg, thank you especially for coming back for a 2nd round to help even further. Your idea to store the previously highlighted Label value was such an easy solution that I didn't think of.

On a side note: I don't know if your constants are a potential substitute for storing data instead of using a cell, but if they are, then I would love to consider them. I have tried to understand how to use them and I am not quite certain how and if they work like I need.

Thanks again Gregg and Domenic! Let me know if there is anything I can do to repay you for your generous help. I left a positive rep for you.

Regards, SocratesJC

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address <> "$A$4" Then Exit Sub

Dim Var As Integer
Dim Var2 As Integer

Var2 = Range("A7").Value
Var = Range("A4").Value

UserForm1.LabelUnit1.Caption = Range("ba" & Var).Value

ActiveSheet.OLEObjects("Label" & Var2).Object.BackColor = RGB(51, 102, 255)
ActiveSheet.OLEObjects("Label" & Var).Object.BackColor = RGB(151, 102, 155)

Range("a7").Value = Range("a4").Value

End Sub

Thanks Greg, I feel the need to think up another way to say thanks before the word gets worn out.

I tested your workbook and it appears to ardently outperform my own. I am going to take a shot at implementing it into my project via copy-paste. I am confident I can manage to tweak/edit it sufficiently to make it work. It might take me a while longer to fully understand it enough to reproduce it entirely from scratch on my own in the future.

It is a shame I don't have a nice giant bank-roll. If I did I would hire you in an instant Greg.

Kind regards,
SocratesJC

Ps- Is it against any forum rules to exchange emails?

Hi again,

Many thanks for your kind words

I've taken a quick look at your workbook and it's certainly impressive from someone who's been using VBA for only four months!

The attached workbook is a slightly modified version of the last one I posted - as per your original requirement, it stores only the digital suffix of the selected Label, so that value will be available for any of your other routines which require it.

Take a look at it and see what you think - let me know if you need any further information.

Best regards,

Greg M

Hi again,

It was a simple fix: one of the lines of codes was set to comment...

 '.OLEObjects(sCurrentLabelName).Object.BackColor = lHighlightColour

Fixed.

Greg,

Thank you for your compliments; I have been working very hard since the summer trying to teach myself.

The workbook successfully stores only the suffix, but the color change is not occurring.

Regards,

Brandon

Thanks Greg,

The code above is just wonderful. I have been very happy with the speed it is operating at. Once more, thank you Greg.

Hi again,

Many thanks for all of your feedback - I'm really pleased to hear that everything is working correctly (and quickly ) at your end.

Best regards,

Greg M