Solved

Color Selected (Single Click) Cell with a background color

Posted on 2011-03-02
10
332 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
ID: 35021982
   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
ID: 35022043
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
ID: 35022221
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
ID: 35022433
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
ID: 35042003
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
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 
LVL 50

Accepted Solution

by:
Ingeborg Hawighorst earned 150 total points
ID: 35042019
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
ID: 35042119
ABSOLUTELY PERFECT!  And I can learn a little, too, by both of your explanations.  Thank you both!
0
 

Author Closing Comment

by:BBlu
ID: 35042122
Thank you both very much.
0
 

Author Comment

by:BBlu
ID: 35042130
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:Ingeborg Hawighorst
ID: 35042144
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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Sparklines have been introduced with Excel 2010 and are a useful tool for creating small in-cell charts, used for example in dashboards. Excel 2010 offers three different types of Sparklines: Line, Column and Win/Loss. What it does not offer is a…
This article descibes how to create a connection between Excel and SAP and how to move data from Excel to SAP or the other way around.
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.

920 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

16 Experts available now in Live!

Get 1:1 Help Now