Forum Discussion

Netrix650's avatar
Netrix650
Copper Contributor
Feb 01, 2023
Solved

VBA code to change (revert) Cell Colour when clicking out of cell (ie not the active cell)

Hi all,

Quite new to VBA so always looking for better ways to do "stuff" and found some interesting code on this site already.
I have some code relating to an office floorplan that I have constructed in Excel.

Using a list of users in one tab, If I highlight the cell containing the user's desk number and run my code - the code will look at the 1st character of the cell (the floor number) > switch tabs to the relevant floor plan > make the cell on the floor plan that matches the desk number the Active cell > and finally change the back ground colour of that cell to make it stand out.
What I cannot figure out is how to revert the cell colour to its original value when I click away from it.

 

If unable to revert the colour to the colour it was, then setting it to a fixed colour when the cell is not active is just as good as the original cell background of all cells in the floor plan are the same


Code : [at present the just working on the first IF to change colour and revert it - will copy to rest of code eventually]

 

Many thanks in advance for any help !

 

 

 

 

Sub FindDesk()
Dim deskNo As String

deskNo = ActiveCell
'MsgBox deskNo
    If Left(deskNo, 1) = 1 Then
        Sheets("First floor").Select
                Cells.Find(What:=deskNo, After:=ActiveCell, LookIn:=xlFormulas2, LookAt:= _
                xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
                , SearchFormat:=False).Activate
                
        ActiveCell.Interior.Color = vbGreen
        
        'NEED CODE HERE TO REVERT CELL TO ORIGINAL BACKGROUND WHEN IT IS NOT THE ACTIVE CELL

        Else
                If Left(deskNo, 1) = 2 Then
                    Sheets("Second floor").Select
                        Cells.Find(What:=deskNo, After:=ActiveCell, LookIn:=xlFormulas2, LookAt:= _
                        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
                        , SearchFormat:=False).Activate
        Else
                            If Left(deskNo, 1) = 4 Then
                                Sheets("Fourth floor").Select
                                    Cells.Find(What:=deskNo, After:=ActiveCell, LookIn:=xlFormulas2, LookAt:= _
                                    xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
                                    , SearchFormat:=False).Activate
    End If
                End If
                            End If
End Sub

 

 

 

 

 

  • Netrix650 << … when I click away from it >>

    The Excel object model does not support just a Click event (it does support DoubleClick and RightClick events), so it appears that you should use the SelectionChange event of the "floor" worksheets.  (So you will advance from writing macro code to writing event handler code, and get more experience with VBA objects.)  Such code is also written using the Visual Basic Editor (VBE), which offers some additional object-oriented assistance, as you will see below.

     

    If you were modeling just one floor, or otherwise were using just one "floor" worksheet, you could do handle this more simply.  But to handle "green cells" on multiple spreadsheets at once…

     

    Your FindDesk procedure needs some modifications, as here:

    Sub FindDesk()
    
        Dim deskNo  As String
        Dim objSheet    As Worksheet
        
        '----   Grab the user-specified desk identifier.
        deskNo = ActiveCell.Value
        'MsgBox deskNo
        
        '----   Select the worksheet that should contain that desk identifier,
        '       based on a floor number encoded at its start.
        '       If the identifier is "not valid", warn the user and exit.
        If Left(deskNo, 1) = 1 Then
            Set objSheet = Sheets("First floor")
        ElseIf Left(deskNo, 1) = 2 Then
            Set objSheet = Sheets("Second floor")
        ElseIf Left(deskNo, 1) = 4 Then
            Set objSheet = Sheets("Fourth floor")
        Else
            Call MsgBox(deskNo & " is not a recognized identifier." _
                , vbExclamation Or vbOKOnly)
            Exit Sub
        End If
        objSheet.Select
        
        '----   Locate the next cell (there probably should be just one) that
        '       contains the desk identifier.
        '   [I would expect an error handler to be enabled here, if not earlier,
        '   unless other code ensures that the deskNo will be found.]
        Cells.Find(What:=deskNo, After:=ActiveCell, LookIn:=xlFormulas2, LookAt:= _
            xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
            , SearchFormat:=False).Activate
        
        'NEED CODE HERE TO REVERT CELL TO ORIGINAL BACKGROUND WHEN IT IS NOT THE ACTIVE CELL
        '   [This is probably not the place to do that.  After all, doing that
        '   here would mean you would have to call this procedure again to clear
        '   the highlighting.
        '   However, this is the place to capture the cell's address or reference,
        '   and its about-to-be-changed color.]
        Call CallByName(objSheet, "CaptureCurrentStuff", VbMethod, ActiveCell)
        
        '----   Highlight that cell in green.  [You can replace vbGreen with the
        '       RGB function for some lighter or mixed-color shade.]
        ActiveCell.Interior.Color = vbGreen
        
        '----   Clean up.
        Set objSheet = Nothing
    
    End Sub

    You will note that:

     

    • You can include comments!  Those are good for others, and for yourself in weeks/months/years to come when you have to look at the code again.  And this becomes more important as the code (almost inevitably) becomes more complex.
    • By rearranging the code, you don't need three copies of the Cells.Find statement.

     

    Then open the code window for one of your "floor" worksheets.  You should see "(General)" in the dropdown at upper left and "(Declarations)" in the upper right.  Select "Worksheet" from the former, and VBE will automatically start the code for an event handler; it chooses "SelectionChanged" by default when you don't already have other event handlers.  Code to place in this module should eventually look like this (although the order of the two procedures does not matter):

    Option Explicit
    
    
        '====   WORKSHEET-SCOPE VARIABLES
        Private m_PriorDeskCell     As Range
        Private m_PriorDeskColor    As Long
    
    
    Public Sub CaptureCurrentStuff(ByRef iobjActiveCell As Range)
    
        '----   Create a worksheet-scope object reference to that cell;
        '       copy the properties that are to be retained.
        Set m_PriorDeskCell = iobjActiveCell
        m_PriorDeskColor = iobjActiveCell.Interior.Color
    
    End Sub
    
    
    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
        '----   Clear the highlighting, if any, from the prior
        '       active range.
        If m_PriorDeskCell Is Nothing Then
            'No action is needed.
        Else
            '  --   Reset the color.
            m_PriorDeskCell.Interior.Color = m_PriorDeskColor
            '  --   Destroy the object reference.
            Set m_PriorDeskCell = Nothing
        End If
    
    End Sub

     

    Repeat as needed for each "floor" worksheet.

     

    I am attaching a workbook with this code for you to experiment with.

7 Replies

  • SnowMan55's avatar
    SnowMan55
    Bronze Contributor

    Netrix650 << … when I click away from it >>

    The Excel object model does not support just a Click event (it does support DoubleClick and RightClick events), so it appears that you should use the SelectionChange event of the "floor" worksheets.  (So you will advance from writing macro code to writing event handler code, and get more experience with VBA objects.)  Such code is also written using the Visual Basic Editor (VBE), which offers some additional object-oriented assistance, as you will see below.

     

    If you were modeling just one floor, or otherwise were using just one "floor" worksheet, you could do handle this more simply.  But to handle "green cells" on multiple spreadsheets at once…

     

    Your FindDesk procedure needs some modifications, as here:

    Sub FindDesk()
    
        Dim deskNo  As String
        Dim objSheet    As Worksheet
        
        '----   Grab the user-specified desk identifier.
        deskNo = ActiveCell.Value
        'MsgBox deskNo
        
        '----   Select the worksheet that should contain that desk identifier,
        '       based on a floor number encoded at its start.
        '       If the identifier is "not valid", warn the user and exit.
        If Left(deskNo, 1) = 1 Then
            Set objSheet = Sheets("First floor")
        ElseIf Left(deskNo, 1) = 2 Then
            Set objSheet = Sheets("Second floor")
        ElseIf Left(deskNo, 1) = 4 Then
            Set objSheet = Sheets("Fourth floor")
        Else
            Call MsgBox(deskNo & " is not a recognized identifier." _
                , vbExclamation Or vbOKOnly)
            Exit Sub
        End If
        objSheet.Select
        
        '----   Locate the next cell (there probably should be just one) that
        '       contains the desk identifier.
        '   [I would expect an error handler to be enabled here, if not earlier,
        '   unless other code ensures that the deskNo will be found.]
        Cells.Find(What:=deskNo, After:=ActiveCell, LookIn:=xlFormulas2, LookAt:= _
            xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
            , SearchFormat:=False).Activate
        
        'NEED CODE HERE TO REVERT CELL TO ORIGINAL BACKGROUND WHEN IT IS NOT THE ACTIVE CELL
        '   [This is probably not the place to do that.  After all, doing that
        '   here would mean you would have to call this procedure again to clear
        '   the highlighting.
        '   However, this is the place to capture the cell's address or reference,
        '   and its about-to-be-changed color.]
        Call CallByName(objSheet, "CaptureCurrentStuff", VbMethod, ActiveCell)
        
        '----   Highlight that cell in green.  [You can replace vbGreen with the
        '       RGB function for some lighter or mixed-color shade.]
        ActiveCell.Interior.Color = vbGreen
        
        '----   Clean up.
        Set objSheet = Nothing
    
    End Sub

    You will note that:

     

    • You can include comments!  Those are good for others, and for yourself in weeks/months/years to come when you have to look at the code again.  And this becomes more important as the code (almost inevitably) becomes more complex.
    • By rearranging the code, you don't need three copies of the Cells.Find statement.

     

    Then open the code window for one of your "floor" worksheets.  You should see "(General)" in the dropdown at upper left and "(Declarations)" in the upper right.  Select "Worksheet" from the former, and VBE will automatically start the code for an event handler; it chooses "SelectionChanged" by default when you don't already have other event handlers.  Code to place in this module should eventually look like this (although the order of the two procedures does not matter):

    Option Explicit
    
    
        '====   WORKSHEET-SCOPE VARIABLES
        Private m_PriorDeskCell     As Range
        Private m_PriorDeskColor    As Long
    
    
    Public Sub CaptureCurrentStuff(ByRef iobjActiveCell As Range)
    
        '----   Create a worksheet-scope object reference to that cell;
        '       copy the properties that are to be retained.
        Set m_PriorDeskCell = iobjActiveCell
        m_PriorDeskColor = iobjActiveCell.Interior.Color
    
    End Sub
    
    
    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
        '----   Clear the highlighting, if any, from the prior
        '       active range.
        If m_PriorDeskCell Is Nothing Then
            'No action is needed.
        Else
            '  --   Reset the color.
            m_PriorDeskCell.Interior.Color = m_PriorDeskColor
            '  --   Destroy the object reference.
            Set m_PriorDeskCell = Nothing
        End If
    
    End Sub

     

    Repeat as needed for each "floor" worksheet.

     

    I am attaching a workbook with this code for you to experiment with.

    • Netrix650's avatar
      Netrix650
      Copper Contributor
      Wow !! Thank you SnowMan55 it does exactly what I asked for, and thank you for taking the time to explain each step - very much appreciated.
      Consolidating the code down made perfect sense - if I'm honest the Event Handler code is still a bit "smoke and mirrors" 😄 but I'll get there !!
      Thanks again
  • NikolinoDE's avatar
    NikolinoDE
    Gold Contributor

    Netrix650 

    Just a thought 🙂

     

     

    ActiveSheet.Cells.Interior.ColorIndex = 0

     

    A small code where with the right mouse button it resets the cell color in the basic color of Excel.

     

    Option Explicit
    Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range("A1:A10")) Is Nothing Then
     Cancel = True
    ActiveSheet.Cells.Interior.ColorIndex = 0
    End If
    End Sub

     

    maybe it helps 🙂

     

    NikolinoDE

    I know I don't know anything (Socrates)

     

    • Netrix650's avatar
      Netrix650
      Copper Contributor

      Thanks for this NikolinoDE - been off work for a couple of days so not tried it yet, but will do - and revert with the outcome.

      • Netrix650's avatar
        Netrix650
        Copper Contributor
        Looking at this code a little closer, would it not reset all the cells back to "no fill" ?
        ActiveSheet.Cells.Interior.ColorIndex = 0

        The sheet has many cells that have a fill colour - my code will change the Fill Colour from the Active Cell (the cell containing the Desk Number) - currently changes it from Green to Yellow - I would like to revert just the once cell back to Green.
        The Desk Number is stored as a variable (deskNo) and would think to use code to say if active cell is not equal to deskNo - cell colour = Yellow - but not sure of how to write this code or where to place it ?

Resources