Tick box

[Jock]

Can I have a column formatted similar to a tick box which will, when a cell
is 'ticked', turn the cell red or flash red every second or have a flag (like
the prioity flag within Outlook) appear in the cell or put a red border
around the row (A-Z) in which the 'tic' box cell is in?
I actually would prefre the latter of the options if poss.
Lots to chew on there!

 

[paul.robinson]

Hi
You should be able to adapt this (for your preferred option). It runs
when you double click a cell in the first column (A).

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel
As Boolean)
Dim myRow As Range
If Not Intersect(Target, ActiveSheet.Columns("A")) Is Nothing Then
Set myRow = Target.Resize(, 26)
With myRow
.Borders.Color = RGB(255, 0, 0)
.Borders(xlInsideVertical).Color = RGB(255, 255, 255)
End With
End If
'Cancel = True
End Sub

Open the VBE and double click the sheet name you want this to work on.
Paste in this code.
Putting Cancel = True stops people editing the cell after double
clicking, which may not be what you want (so I've left it commented
out).
regrds
Paul

 

[Jock]

Hi Paul,
Excellent stuff.
However, My column is 'M' and the bordered area is from 'M' to 'AL' rather
than 'A' - 'Z'. Can that be adapted?
Also, I'd like to be able to double click a second time to "de-border" the
cells.
I don't know if this is poss, but all help greatly appreciated.

Thanks,
Jock

Hi
You should be able to adapt this (for your preferred option). It runs
when you double click a cell in the first column (A).

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel
As Boolean)
Dim myRow As Range
If Not Intersect(Target, ActiveSheet.Columns("A")) Is Nothing Then
Set myRow = Target.Resize(, 26)
With myRow
.Borders.Color = RGB(255, 0, 0)
.Borders(xlInsideVertical).Color = RGB(255, 255, 255)
End With
End If
'Cancel = True
End Sub

Open the VBE and double click the sheet name you want this to work on.
Paste in this code.
Putting Cancel = True stops people editing the cell after double
clicking, which may not be what you want (so I've left it commented
out).
regrds
Paul

 

[paul.robinson]

Hi
1. Did you try changing the A to an M??!
2. For the deselect you could try

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel
As Boolean)
Dim myRow As Range
If Not Intersect(Target, ActiveSheet.Columns("M")) Is Nothing Then
Set myRow = Target.Resize(, 26)
With myRow
If .Borders(xlEdgeTop).Color = RGB(255, 0, 0) then
.Borders.LineStyle = xlnone
Else
.Borders.Color = RGB(255, 0, 0)
.Borders(xlInsideVertical).Color = RGB(255, 255, 255)
End If
End With
End If
'Cancel = True
End Sub

regards
Paul

 

[Jock]

That turns it on and off ok. Thanks.
I had already changed A to M but, the code works to the right of the cell
double clicked.

Thanks
Jock

 

[Jock]

I have worked around th issue by using column 'B'.
I have noticed that, after turning the code on and off, certain cell borders
are missing (columns B & E). Why would this happen?
Is it possible to use a wider (thicker) red border?

 

[paul.robinson]

Hi
For the thicker border
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel
As Boolean)
Dim myRow As Range
If Not Intersect(Target, ActiveSheet.Columns("B")) Is Nothing Then
Set myRow = Target.Resize(, 26)
With myRow
If .Borders(xlEdgeTop).Color = RGB(255, 0, 0) Then
.Borders.LineStyle = xlNone
Else
.Borders.Color = RGB(255, 0, 0)
.Borders.Weight = xlThick
.Borders(xlInsideVertical).Color = RGB(255, 255, 255)

End If
End With
End If
'Cancel = True
End Sub

Q1: I dont' know what you mean by "I have worked around the issue by
using column 'B'." What issue?

Q2 "I have noticed that, after turning the code on and off, certain
cell borders
are missing (columns B & E). Why would this happen?"
Did your data originally have borders round it? My macro will
certainly interfere with that. I couldn't provide a fix without
knowing what the borders are like. Also, if you do have borders
already, putting in a new one is probably not the best thing to do. It
would be better to highlight your data on double click like this

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel
As Boolean)
Dim myRow As Range
If Not Intersect(Target, ActiveSheet.Columns("M")) Is Nothing Then
Set myRow = Target.Resize(, 26)
With myRow
If .Interior.ColorIndex = 6 Then
.Interior.ColorIndex = xlNone
Else
.Interior.ColorIndex = 6
End If
End With
End If
'Cancel = True
End Sub

regards
Paul

 

[Jock]

Hi,
What I was referring to in 'Q1' was that I would have liked cells A to Z
highlighted in a specific row when a cell in M is double clicked. What
happens is that the count of 26 cells starts from the column stated in the
code (M) and ends at AL. I got around this by using B rather than M, so that
B to Z are highlited.
In Q2, there were no border changes done by me to the standard 'new
worksheet' default ones. There is quite a lot of code for different things
within this workbook though, so perhaps they are interfering with your code
slightly: I have tested your codes in a blank workbook and they work fine.

Thanks for your help on this. The yellow highlighted stand out better than
the red bordered ones, I think. Brill

Where's 'ie' by the way (in your email addy)

Many thanks
Jock

 

[paul.robinson]

Hi
I'm with you now on the A to Z thing. You want

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel
As Boolean)
Dim myRow As Range
If Not Intersect(Target, ActiveSheet.Columns("M")) Is Nothing Then
Set myRow = Target.offset(0,-12).Resize(, 26) 'go back to "A"
With myRow
If .Interior.ColorIndex = 6 Then
.Interior.ColorIndex = xlNone
Else
.Interior.ColorIndex = 6
End If
End With
End If
'Cancel = True
End Sub

The .ie is Ireland. My College can't give me a fake email for
newsgroup purposes. They get a lot of spam funnily enough...
regards
Paul

 

[Jock]

Just the ticket. Thanks very much.
--
tia

Jock

Hi
I'm with you now on the A to Z thing. You want

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel
As Boolean)
Dim myRow As Range
If Not Intersect(Target, ActiveSheet.Columns("M")) Is Nothing Then
Set myRow = Target.offset(0,-12).Resize(, 26) 'go back to "A"
With myRow
If .Interior.ColorIndex = 6 Then
.Interior.ColorIndex = xlNone
Else
.Interior.ColorIndex = 6
End If
End With
End If
'Cancel = True
End Sub

The .ie is Ireland. My College can't give me a fake email for
newsgroup purposes. They get a lot of spam funnily enough...
regards
Paul

 

[Jock]

Hi Paul,
me again.
Some bright spark in the office asked, with ref to the highlighting code you
supplied, if it was possible to adapt it to change from yellow to orange
after 3 weeks and then fom orange to red after 6 weeks. Column L is a date
field so perhaps this could be utilised?
Bit of a challenge!
Thanks
Jock

 

[paul.robinson]

Hi
That is possible. I'm off home now but I'll try and look at it
tomorrow.
Paul

 

[paul.robinson]

Hi
This assumes there is a date in column J when you click the cell in
column M. You can format the date in J as you like.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel
As Boolean)
Dim myRow As Range
Dim TempDays As Variant, CellColour as Variant

If Not Intersect(Target, ActiveSheet.Columns("M")) Is Nothing Then
TempDays = Date - DateValue(Target.Offset(0,-3).Text) 'days
between today and date in column J
'choose cell colour based on date in J
If TempDays > 42 Then
CellColour = 3 'red
elseIf TempDays>21 Then
CellColour = 46 'orange
else
CellColour = 6 'yellow
End if
'colour the cells
Set myRow = Target.offset(0,-12).Resize(, 26) 'go back to "A"
With myRow
If .Interior.ColorIndex = xlNone Then
.Interior.ColorIndex = CellColour
Else
.Interior.ColorIndex = xlnone
End If
End With
End If
'Cancel = True
End Sub

regards
Paul

 

[Jock]

Great stuff Paul.
Thanks very much