PDA

View Full Version : [SOLVED] Coloring Selection



Ringhal
11-04-2013, 01:35 AM
Hi VBA Experts
I have a small peice of code that changes the selection to a different color, so its easier to identify the selected cell row, as below:


Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim r As Variant
Static rr
If rr "" Then
With Rows(rr)
.Interior.ColorIndex = xlNone
End With
End If
r = Selection.Row
rr = r
With Rows(r)
With .Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
End With
End Sub

It works fine as it is, however, it restores the previous cell row (the one that was selected) to the standard "no fill". Hopefully, with the help of the experts, I can restore the cell to the coloring it was previously. The problem is, my sheet is like a christmas tree or rainbow and has many different colors, and also has conditional formatting, which I use to help me identify certain data.

Is there code that will save the formatting of a cell (either single cell or an entire row) into a variable or elsewhere, without using copy/paste and restore it when the selection changed?

EDIT: Something wierd happened when I posted this post the first time, everything appeared on one line. Edited to fix the formatting.

snb
11-04-2013, 04:56 AM
In your case you could use:


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
UsedRange.Borders(xlDiagonalUp).ColorIndex = xlNone
With Application.ActiveWindow.VisibleRange
Range(.Columns(Target.Column - .Columns(1).Column + 1).Address & "," & .Rows(Target.Row - .Rows(1).Row + 1).Address).Borders(xlDiagonalUp).ColorIndex = 12
End With
End Sub

Ringhal
11-04-2013, 05:44 AM
Thanks snb for the code

Your code almost does what I want, however it uses borders instead of colors as I was looking for. I will use it for the moment and keep this thread unsolved. I'm not sure if it is possible to do exactly what I want with VBA, but hopefully it can be done.

SamT
11-04-2013, 06:10 AM
This code will work on every sheet it is placed in , or you can rename the Selection Change sub to fit it in the ThisWorkbook Module.

I added the RestoreLast sub to handle the situation when you close the workbook. You should call it before Saving the Book.

Because of the difficulty in storing many cells' attributes at once, I used a Border for the Row and only colored the actual Cell Selected. You can easily add a column Border to put the Selection in cross hairs.


Option Explicit

Dim PSel As Range 'Stores the Cell address and Value
Dim PColor As Long
Dim PPattern As Long

Private Property Get PreviousSel() As Range
'Gets and Returns the stored Address and Value
Set PreviousSel = PSel
End Property
Private Property Let PreviousSel(NewSel As Range)
'Puts the Range into the Storing Variable
Set PSel = NewSel
End Property

'Performs similar to above
Private Property Get PreviousColor() As Long
PreviousColor = PColor
End Property
Private Property Let PreviousColor(NewColor As Long)
PColor = NewColor
End Property

Private Property Get PreviousPattern() As Long
PreviousPattern = PPattern
End Property
Private Property Let PreviousPattern(NewPattern As Long)
PPattern = NewPattern
End Property

Sub RestoreLast()
Dim Sel As Range

'Restore previous color to last selection and remove border
If Not PreviousSel Is Nothing Then
Set Sel = PreviousSel
With Sel
With .Interior
.ColorIndex = PreviousColor
.Pattern = PreviousPattern
End With
.EntireRow.Borders.LineStyle = xlNone
End With
End If
End Sub

Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim Sel As Range 'Used for all Range assignments

'If more than 1 Cell selected then Exit
If Target.Count > 1 Then Exit Sub

'Restore previous color to last selection and remove border
If Not PreviousSel Is Nothing Then
Set Sel = PreviousSel
With Sel
With .Interior
.ColorIndex = PreviousColor
.Pattern = PreviousPattern
End With
.EntireRow.Borders.LineStyle = xlNone
End With
End If

'Save current Selection and color
Set Sel = Target
PreviousSel = Sel
PreviousColor = Sel.Interior.ColorIndex
PreviousPattern = Sel.Interior.Pattern

'Highlight Selection
With Sel
'Add Border to Row
With .EntireRow.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.Color = RGB(255, 0, 0)
End With
'Color Cell
With .Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
End With
End Sub

snb
11-04-2013, 06:33 AM
@SamT

If you format entire rows/columns the 'usedrange' will grow dramatically and the slowness of the workbook accordingly.

Ringhal
11-04-2013, 07:19 AM
Thanks SamT for the code and snb for the input.

Here is some extra info that may or may not help. The font color and cell (interior) color are the only important attributes that need to be 'saved'. If highlighting the entire row/column will slow down the workbook too much as snb pointed out, only highlighting the single selected cell will do. This code only needs work on about 6 columns (A to F) and about 44 rows (1 to 44) on a single worksheet, the rest of the cells are blank.

SamT
11-04-2013, 07:24 AM
@ snb

I know. That's why ".EntireRow.Borders.LineStyle = xlNone "

From OP

The problem is, my sheet is like a christmas tree or rainbow and has many different colors, and also has conditional formatting, which I use to help me identify certain data.

I could have found the last used column and only bordered that part of the row, but ya gotta leave something the OP has to do.

It sounded to me like he had a large sheet, many screens, and needed to scroll around it quite a bit. That's also why I suggested a column border.

Paul_Hossler
11-04-2013, 05:37 PM
If all you want to do is restore the previously selected row's fill, you could do something like this (in 2007/2010 at least)

Just uses an array to hold the color values of the row before you make it yellow

Only does the first row of the selected since it's less complicated than making it completely general



Option Explicit
Dim aiOldColors(1 To 16384) As Long
Dim rOldRow As Range
Private Sub Worksheet_Activate()
Dim iCol As Long

Set rOldRow = ActiveCell.EntireRow

For iCol = LBound(aiOldColors) To UBound(aiOldColors)
aiOldColors(iCol) = rOldRow.Cells(1, iCol).Interior.ColorIndex
Next iCol

End Sub
Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim iCol As Long

'restore previous
If Not rOldRow Is Nothing Then
For iCol = LBound(aiOldColors) To UBound(aiOldColors)
rOldRow.EntireRow.Cells(1, iCol).Interior.ColorIndex = aiOldColors(iCol)
Next iCol
End If
'save new OldRow
Set rOldRow = Target.Rows(1).EntireRow
'save the current selection colors
For iCol = LBound(aiOldColors) To UBound(aiOldColors)
aiOldColors(iCol) = rOldRow.Cells(1, iCol).Interior.ColorIndex
Next iCol
'make the current row yellow
With Target.Rows(1).EntireRow
With .Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
End With

End Sub



Pretty brute force, and not throughly tested

Paul

Ringhal
11-05-2013, 01:28 AM
@SamT
Your code appears to do mostly what I want, but as I mentioned before, the font is also different colors (dark or light) so, when I select a cell that has white font I cannot read the text, but its OK when the font is black. I attempted to fix this myself, but I couldn't get it to work.

Also, when I reopen the workbook, the previously selected cell formatting is 'saved' and doesn't change back to the orignal formatting. I am assuming that is what the 'RestoreLast' Sub is for, but it doesn't seem to work. I should probably mention that I have code which runs on Workbook_BeforeClose Event that saves the workbook in a new file, and I always open the latest file.

@ snb

I know. That's why ".EntireRow.Borders.LineStyle = xlNone "

I could have found the last used column and only bordered that part of the row, but ya gotta leave something the OP has to do..
I modified that line and the simiar one to "Range("A" & .Row & ":F" & .Row).Borders.LineStyle = xlNone" instead of it highlighting the entire row.


It sounded to me like he had a large sheet, many screens, and needed to scroll around it quite a bit. That's also why I suggested a column border.My apologies for not being clearer in the OP. The cells are only the ones I can see without scrolling, as I mentioned in my previous post (A1 to F44).

-
@Paul_Hossler
I tested your code and it works but with each selection change, there is a 2 second delay before the colors change. I'm not sure if its your code or my workbook that's causing it.

-
@anyone
Another minor problem, but not important at all, the cells also have borders and the borders are cleared when I change selection. I can re-apply the borders with a seperate piece of code to fix that issue.

Sam's code is the closes to what I need, and if the 2 small issues (re-opeing the workbook and the font colors) are fixed, the code will be perfect.

Thanks for everyone's help with this.

Paul_Hossler
11-05-2013, 06:04 AM
@Paul_Hossler
I tested your code and it works but with each selection change, there is a 2 second delay before the colors change. I'm not sure if its your code or my workbook that's causing it.


Well .... the code is doing a lot, 16K+ loops

Instead of the entire row, it could be faster with a much smaller range

Paul

snb
11-05-2013, 09:04 AM
I'd prefer a method that doesn't interfere with the worksheet's content; see the attachment.

SamT
11-06-2013, 04:48 AM
For each Cell property you want to save/change, add it to the Variable declarations, and add the Property Get and Property Let Subs to the next section of code. Edit the RestoreLast Function and the Property Assignments in the Selection_Change sub to suit. I included a Before_Save Sub for the ThisWorkbook Code, but you can also call RestoreLast from a Worksheet_Deactivate Sub.

Note that I changed to Parameter names in the Property Let Subs for your study. All the subs are correctly written and will work as is.


Option Explicit

'Declarations
Dim PSel As Range
Dim PColor As Long
Dim PPattern As Long
Dim PFontColor As Long
'Dim Borders ????? LineStyle, Weight, and Color As Variant or Long

Custom Worksheet Property Subs

Private Property Get PreviousSel() As Range
Set PreviousSel = PSel
End Property
Private Property Let PreviousSel(NewSelectedCell As Range)
Set PSel = NewSelectedCell
End Property

Private Property Get PreviousColor() As Long
PreviousColor = PColor
End Property
Private Property Let PreviousColor(Existing_CellColor As Long)
PColor = Existing_CellColor
End Property

Private Property Get PreviousPattern() As Long
PreviousPattern = PPattern
End Property
Private Property Let PreviousPattern(X As Long)
PPattern = X
End Property



Function RestoreLast()
Dim Sel As Range

If Not PreviousSel Is Nothing Then
'Restore saved formats to last Selection

Set Sel = PreviousSel
With Sel
With .Interior
.ColorIndex = PreviousColor
.Pattern = PreviousPattern
End With

'.Font.Color = PreviousFontColor
'Borders = ?????
End With

'Prevent Double-Calls problems
PreviousSel = Nothing

End If
End Function


Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim Sel As Range 'Used for all Range assignments

'If more than 1 Cell selected then Exit
If Target.Count > 1 Then Exit Sub

'Restore Formats to Previous Selection
RestoreLast

'Save current Selection and color
Set Sel = Target

PreviousSel = Sel
With Sel
PreviousColor = .Interior.ColorIndex
PreviousPattern = .Interior.Pattern
PreviousFontColor = .Font.Color
'PreviousBorders = ?????
End With

'Highlight Selection
With Sel

'Add Borders to Sel
With .Borders
.LineStyle = xlDouble
.Color = RGB(255, 0, 0)
End With

'Color Cell
With .Interior
.ColorIndex = 6
.Pattern = xlSolid
End With

'Change Font
With .Font
.Color = RGB(255, 0, 0)
End With

End With
End Sub

ThisWorkbook Module Code

Private Sub Workbook_BeforeSave(ByVal SaveAsUi As Boolean, Cancel As Boolean)

'Modify Sheet name to suit
Const HighlightedSheetName As String = "Sheet1"

Sheets(HighlightedSheetName).RestoreLast
End Sub

Ringhal
11-06-2013, 06:13 AM
@snb
I like the idea of not interfering with the worksheet's content by using shapes. I have copied your code and the shapes from your attached worksheet to my workbook and it seems to work very well. I even modified the code to work only within my small range. The only thing I do not like is the inabilty to select the cells that are covered by the shapes, unless there's a solution for it.

@SamT
I attempted to use your code again, but I received a 'Variable not defined' for 'PreviousFontColor' and when I declared the variable I got 'Can't make an assignment to a read-only property' error. I am unsure on how to resolve that issue.

snb's answer is the best one I think for me as this can easily be used in other workbook/sheets and doesn't affect the content of the sheet. I realised before posting this question that it may be difficult to make this work and was using simple code to easily identify the selected cell.

Thanks to everyone for helping me.
Happy coding

snb
11-07-2013, 01:21 AM
In two steps you can go everywhere you want to: first choose the cell in the target row, then the column of the target column; or the other way around.
It's only 1 step more than without shapes.

An alternative you'll find in the attachment.
Doubleclick the targetcell: the shapes will vanish; after selecting another cell they will return.

Tom Jones
11-07-2013, 03:14 AM
In your case you could use:


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
UsedRange.Borders(xlDiagonalUp).ColorIndex = xlNone
With Application.ActiveWindow.VisibleRange
Range(.Columns(Target.Column - .Columns(1).Column + 1).Address & "," & .Rows(Target.Row - .Rows(1).Row + 1).Address).Borders(xlDiagonalUp).ColorIndex = 12
End With
End Sub


snb,

In your code, if you select a cell in the first column and then select any other cell, the rows and columns will remain with the formatting and will not be deleted if you select other cells.