Solved

Color Selected (Single Click) Cell with a background color

Posted on 2011-03-02
10
327 Views
Last Modified: 2012-05-11

I have a table of figures (total costs across department and month) that I act on with some VBA to provide additional information.  I'd like to be able to color the background of the selected cell within this range, so that the users clearly knows which month and department for which he is requesting additional information.  Is there a simple VBA code that will change the background color of a selected cell?
0
Comment
Question by:BBlu
  • 6
  • 2
  • 2
10 Comments
 
LVL 22

Assisted Solution

by:rspahitz
rspahitz earned 200 total points
Comment Utility
   With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = vbRed
    End With

Instead of vbRed, you can also use various color constants like vbYellow, vbGreen, etc, or actual numbers like 255 for red, 65535 for purple or &HFF0000 for green
0
 

Author Comment

by:BBlu
Comment Utility
Thanks, rspahitz.  Pardon my naivity, but would that be in a new module or in the "This Workbook" area (not sure what you call this)
0
 
LVL 22

Assisted Solution

by:rspahitz
rspahitz earned 200 total points
Comment Utility
I thought you already had VBA code and wanted to insert this.  

The answer depends on what triggers the need for the highlighting.  If you simply want to, for example, highlight columns B C and D of whatever the current row is, try this in the code window of the currnet sheet e.g. Sheet 1:

Private mPrevCell As Range
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not mPrevCell Is Nothing Then
        Cells(mPrevCell.Row, 2).Interior.Pattern = xlNone
        Cells(mPrevCell.Row, 3).Interior.Pattern = xlNone
        Cells(mPrevCell.Row, 4).Interior.Pattern = xlNone
    End If
    SetColor ActiveCell.Row, 2, vbRed
    SetColor ActiveCell.Row, 3, vbYellow
    SetColor ActiveCell.Row, 4, vbGreen
    Set mPrevCell = ActiveCell
End Sub

Private Sub SetColor(RowNumber As Integer, ColumnNumber As Integer, BackColor As Long)
    With Cells(RowNumber, ColumnNumber).Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = BackColor
    End With
End Sub


0
 

Author Comment

by:BBlu
Comment Utility
I'm actually working from within another bit of code that uses the selected cell to show details from another table.  Let me figure that out and send it over to you.  Thanks, again.
0
 

Author Comment

by:BBlu
Comment Utility
Okay, I got my other code to work.  Now, all I'd like to do is change the background color of the cell, if a single cell within the range t8:w13 is selected.  My code is messy, but I've included it just in case it might be helpful.
Sub CommandButton1_Click()
    Dim i As Long, lastRow As Long
    Dim rRow As Long, cCol As Long
    Dim mMonth As Long
    Dim rng As Range
    Dim wb1 As Workbook
    Dim Dept As String

    '~~> Change the range to the relevant range here
    If Intersect(Selection, Range("t8:w13")) Is Nothing Then
        'the intersect function checks to see if the selection exists in the given range
        MsgBox "Please select the cell in the correct range"
        Exit Sub
    End If
    
    Application.ScreenUpdating = False
    'By setting ScreenUpdating to False at the Start of the macro, you will not only stop
    ' the constant screen flickering associated with recorded macro, but also greatly speed
    ' up the execution of the macro. The reason it speeds up code is because Excel no longer
    ' needs to repaint the screen whenever it encounters such commands as Select, Activate,
    ' LargeScroll, SmallScroll and many others.
   
     
    
   'Sheets("QB_Expenses").Activate
    lastRow = Sheets("QB_Expenses").Range("A" & Rows.Count).End(xlUp).Row
    ' finds last row in QB_Expenses Worksheet
 'MsgBox ("The last row is: " & lastRow)
    
   'This part tells the macro which dept/month combination we are working with
   rRow = Selection.Row
  'MsgBox ("The row is: " & rRow)
    cCol = Selection.Column
  '  MsgBox ("The column is: " & cCol)
    mMonth = Month(Cells(7, cCol).Value)
    'What month are we looking for?
    'The month columns are all in row 7
    Dept = Cells(rRow, 14).Value
    'What Dept are we looking for
    'The Departments rows are all in column 14
    'MsgBox (mMonth & "/" & Dept)
    'Creating new table in memory?
    'MsgBox (Month(Sheets("QB_Expenses").Range("c" & 2).Value))
    'MsgBox ("compare to Month" & mMonth)
    'MsgBox (Sheets("QB_Expenses").Range("d" & 2).Value)
    'MsgBox ("comare to Dept" & Dept)
    
    Set rng = Sheets("QB_Expenses").Range("A1:G1")
    'On Error GoTo ErrorCatch
    
    For i = 2 To lastRow
        If Month(Sheets("QB_Expenses").Range("C" & i).Value) = mMonth _
        And _
        Sheets("QB_Expenses").Range("D" & i).Value = Dept Then
           Set rng = Union(rng, Sheets("QB_Expenses").Range("A" & i & ":G" & i))
           'if the month and dept match, add this column to the open workbook
           
        End If
    Next i
    
    Sheets("QB_Expenses").Range(rng.Address).Copy
     Set wb1 = Workbooks.Add
     wb1.Sheets(1).Activate
    ActiveSheet.Paste
    
    '~~> Change the file Name Here
    'wb1.SaveAs "\\adpsfs\Accounting\Bobby\MyFile.xls"
 
Call fitWidth

    Application.CutCopyMode = False
    Application.ScreenUpdating = True

End Sub

Sub fitWidth()
'
' When the sheet is copied, the columns need to be fit to widest and cleaned up a little bit

    ActiveSheet.Cells.Select

ActiveSheet.Cells.EntireColumn.AutoFit
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    ActiveSheet.Range("A1:G1").Select
    
With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.499984740745262
        .PatternTintAndShade = 0
    End With
     
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
   
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    
    
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    
  
    
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    'MsgBox ("still working2")
    ActiveSheet.Range("a1").Select
End Sub

Open in new window

0
Maximize Your Threat Intelligence Reporting

Reporting is one of the most important and least talked about aspects of a world-class threat intelligence program. Here’s how to do it right.

 
LVL 50

Accepted Solution

by:
teylyn earned 150 total points
Comment Utility
Hello,

changing the color of the cell upon click is independent of your existing macro. You'll need a Selection change event in the sheet. Picking up where rspahitz has started:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not intersect(target, range("t8:w13")) is nothing then
       With target.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = vbRed
       End With
end if
end sub

Open in new window


On top of that, you'd probably first want to clear any existing interior colors when another cell within t8:w13 is selected, so that when the selection changes, the cell color moves


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not intersect(target, range("t8:w13")) is nothing then
       Range("t8:w13").Interior.ColorIndex = xlNone
       With target.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = vbRed
       End With
end if
end sub

Open in new window


This code goes into the Sheet module of the sheet, not a standard module.

cheers, teylyn
0
 

Author Comment

by:BBlu
Comment Utility
ABSOLUTELY PERFECT!  And I can learn a little, too, by both of your explanations.  Thank you both!
0
 

Author Closing Comment

by:BBlu
Comment Utility
Thank you both very much.
0
 

Author Comment

by:BBlu
Comment Utility
Actually, one more tweak, if possible.  Once I select a cell inside the range, the background color changes.  That is correct.  If I switch to another cell within the range, the previous cell is cleared out and the newly selected cell is colored. That is correct, too.  But, if I then select a cell outside of the range, the cell I left (the last one selected) remains with the background color.  How would I clear that background, as well?
0
 
LVL 50

Expert Comment

by:teylyn
Comment Utility
Hello,

just move the line

    Range("t8:w13").Interior.ColorIndex = xlNone

up to sit before the IF


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Range("t8:w13").Interior.ColorIndex = xlNone
    If Not intersect(target, range("t8:w13")) is nothing then
       With target.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = vbRed
       End With
end if
end sub

Open in new window

0

Featured Post

Maximize Your Threat Intelligence Reporting

Reporting is one of the most important and least talked about aspects of a world-class threat intelligence program. Here’s how to do it right.

Join & Write a Comment

Convert between Excel file formats (.XLS, .XLSX, .XLSM) with/without macro option David Miller (dlmille) Intro Over this past Fall, I've had the opportunity to see several similar requests and have developed a couple related solutions associate…
How to quickly and accurately populate Word documents with Excel data, charts and images (including Automated Bookmark generation) David Miller (dlmille) Synopsis In this article you’ll learn how to use ExcelToWord! to copy data,charts, shapes …
Graphs within dashboards are meant to be dynamic, representing data from a period of time that will change each time the dashboard is updated with new data. Rather than update each graph to point to a different set within a static set of data, t…
This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.

762 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

7 Experts available now in Live!

Get 1:1 Help Now