Active cell coloured
 

The cell is GREEN while ACTIVE and turns WHITE after it is no lnger ACTIVE.
If my cell is already colour coded, it loses its colour when no longer
ACTIVE. Can this code be changed so that a cell returns to its ORIGINAL
formmating when no longer ACTIVE?
Code is:


Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target
As Excel.Range)
Static OldCell As Range

If Not OldCell Is Nothing Then
OldCell.Interior.ColorIndex = xlColorIndexNone
End If

Target.Interior.ColorIndex = 4

Set OldCell = Target


End Sub

Active cell coloured
 

Try the below

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, _
ByVal Target As Excel.Range)
Static OldCell As Range
Static varIndex As Variant

If Target.Count = 1 Then
If Not OldCell Is Nothing Then OldCell.Interior.ColorIndex = varIndex
varIndex = Target.Interior.ColorIndex
Set OldCell = Target
Target.Interior.ColorIndex = 4
End If

End Sub

If this post helps click Yes
---------------
Jacob Skaria


"Ron" wrote:

The cell is GREEN while ACTIVE and turns WHITE after it is no lnger ACTIVE.
If my cell is already colour coded, it loses its colour when no longer
ACTIVE. Can this code be changed so that a cell returns to its ORIGINAL
formmating when no longer ACTIVE?
Code is:


Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target
As Excel.Range)
Static OldCell As Range

If Not OldCell Is Nothing Then
OldCell.Interior.ColorIndex = xlColorIndexNone
End If

Target.Interior.ColorIndex = 4

Set OldCell = Target


End Sub

Active cell coloured
 

That didn't work. It changed some cells and it didn't hilite others when they
were active. Thank you. Any other ideas?

Active cell coloured
 

In the earlier code I handled a single cell only. A bit more coding is
required to handle a selection or range of cells...Copy pate the entire code
to 'This Workbook' Code module. 1 event code, 2 procedures, and an outside
declaration which remains on top of the 'This Workbook' code module. Try the
below in a new workbook and feedback


Dim arrIndex As Variant
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, _
ByVal Target As Excel.Range)
Static OldCell As Range

If Not OldCell Is Nothing Then ReSetColorIndex OldCell
SetColorIndex Target
Set OldCell = Target
Target.Interior.ColorIndex = 4
End Sub

Sub SetColorIndex(varRange As Range)
Dim intCount As Integer, cell As Object
ReDim arrIndex(varRange.Count)
For Each cell In varRange
intCount = intCount + 1
arrIndex(intCount) = cell.Interior.ColorIndex
Next
End Sub

Sub ReSetColorIndex(varRange As Range)
Dim intCount As Integer, cell As Object
For Each cell In varRange
intCount = intCount + 1
cell.Interior.ColorIndex = arrIndex(intCount)
Next
End Sub


If this post helps click Yes
---------------
Jacob Skaria


"Ron" wrote:

That didn't work. It changed some cells and it didn't hilite others when they
were active. Thank you. Any other ideas?

Active cell coloured
 

If you are making bigger selections; the code will give you an error. To
overcome that change the declaration type of intCount from Integer to the
below in both the procedures.....

intCount As Variant

If this post helps click Yes
---------------
Jacob Skaria


"Jacob Skaria" wrote:

In the earlier code I handled a single cell only. A bit more coding is
required to handle a selection or range of cells...Copy pate the entire code
to 'This Workbook' Code module. 1 event code, 2 procedures, and an outside
declaration which remains on top of the 'This Workbook' code module. Try the
below in a new workbook and feedback


Dim arrIndex As Variant
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, _
ByVal Target As Excel.Range)
Static OldCell As Range

If Not OldCell Is Nothing Then ReSetColorIndex OldCell
SetColorIndex Target
Set OldCell = Target
Target.Interior.ColorIndex = 4
End Sub

Sub SetColorIndex(varRange As Range)
Dim intCount As Integer, cell As Object
ReDim arrIndex(varRange.Count)
For Each cell In varRange
intCount = intCount + 1
arrIndex(intCount) = cell.Interior.ColorIndex
Next
End Sub

Sub ReSetColorIndex(varRange As Range)
Dim intCount As Integer, cell As Object
For Each cell In varRange
intCount = intCount + 1
cell.Interior.ColorIndex = arrIndex(intCount)
Next
End Sub


If this post helps click Yes
---------------
Jacob Skaria


"Ron" wrote:

That didn't work. It changed some cells and it didn't hilite others when they
were active. Thank you. Any other ideas?