PDA

View Full Version : Solved: Highlight the line when certain cell is selected



Dabo
05-15-2009, 02:22 AM
Dear all,

I have a file to do a survey
The user has to rate something on different items, one per line
He is only allowed to select the cells where he can chose the value of his evaluation. ("Disagree", "Neutral" etc)
I am desesperately trying to do that :
When the user clicks on a cell to chose his evaluation, I want the matching Item ("I find that Product X is good" for example) to be highlighted. It would make the grid easier to read.

The difficulty is that it has to happen only when the allowed cells are selected.

I'm not sure I've been very clear but I am open to any idea !

Thanks

Bob Phillips
05-15-2009, 02:31 AM
How about a simple overlay on the whole row? Why just one cell, whole row makes it easier.

Dabo
05-15-2009, 02:34 AM
In fact there are vertically merged cells on the left, I guess that it would be a mess with the whole line ?

Bob Phillips
05-15-2009, 03:06 AM
It would in principle, but if you use a technique like this, it overlays the line so no account is taken of merged cells.



Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim shp As Shape
Dim mpLeft As Double
Dim mptop As Double
Dim mpWidth As Double
Dim mpHeight As Double

With Me

On Error Resume Next
.Shapes("hilite").Delete
On Error GoTo 0

mpLeft = 0
mptop = Target.Top
mpWidth = ActiveWindow.Width
mpHeight = Target.Height

Set shp = .Shapes.AddShape(msoShapeRectangle, mpLeft, mptop, mpWidth, mpHeight)
With shp

.Name = "hilite"
.Fill.Visible = msoTrue
.Fill.Solid
.Fill.ForeColor.SchemeColor = 45
.Fill.Transparency = 0.67 '67% transparency
.Line.Weight = 0.75
.Line.DashStyle = msoLineSquareDot
.Line.Style = msoLineSingle
.Line.Transparency = 0#
.Line.Visible = msoTrue
.Line.ForeColor.SchemeColor = 10
.Line.BackColor.RGB = RGB(255, 255, 255)
End With
End With

End Sub


This is worksheet event code, which means that it needs to be
placed in the appropriate worksheet code module, not a standard
code module. To do this, right-click on the sheet tab, select
the View Code option from the menu, and paste the code in.

Dabo
05-15-2009, 03:14 AM
Thanks,

I just tried but I got a RunTimeError 1004
Should I make any change to adapt it to my file ?

Aussiebear
05-15-2009, 03:17 AM
Which line did it error out on?

Dabo
05-15-2009, 03:32 AM
Set shp = .Shapes.AddShape(msoShapeRectangle, mpLeft, mptop, mpWidth, mpHeight)

Bob Phillips
05-15-2009, 04:24 AM
Did you add it to a sheet module as I said?

Dabo
05-15-2009, 04:32 AM
Sure I did.
I will try on another sheet.

A friend suggests me to use a conditional formating on the cell I need to highlight. Is it possible to put a conditional formating with that kind of structure "IfActive(Allowed Cell;Highlight(Cell to highlight);Do nothing)"
?

Bob Phillips
05-15-2009, 06:09 AM
No, not directly. I have some code that does it with event code, but it is similar to the code I already gave, and it has the huge disadvantage of removing existing CF.

Dabo
05-15-2009, 06:28 AM
I finally made it !
Based on your code, this is what I did:
I put my "allowed cells" in yellow or grey and then made a test on the active cell to highlight the matching cell.
(it is not clean code but it works well)

Thanks !



Public Sub Worksheet_SelectionChange(ByVal target As Range)
Dim n As Long
Dim i As Long
Dim color As Long
Dim boola As Boolean
boola = False
color = 6
n = ActiveCell.Column
If n < 23 And boolsel Then

On Error GoTo Label:
rngold.Interior.ColorIndex = 0
rngold.Pattern = xlSolid
Label:
For i = 1 To 7
If ActiveCell.Offset(0, i).Interior.ColorIndex = 36 Then
boola = True
End If
Next i

If ActiveCell.Interior.ColorIndex = 36 Or (ActiveCell.Interior.ColorIndex = 15 And boola) Then
Dim m As Long
m = ActiveCell.Row
Range("E" & m).Interior.ColorIndex = color
Range("E" & m).Interior.Pattern = xlSolid
Range("C" & m).Interior.ColorIndex = color
Range("C" & m).Interior.Pattern = xlSolid

i = 0
Label3:
If Range("D" & m - i).Value = "" Then
i = i + 1
GoTo Label3:
End If
Range("D" & m - i).Interior.Pattern = xlSolid
Range("D" & m - i).Interior.ColorIndex = color

Set rngold = Range("E" & m & ":C" & m, "D" & m - i)


End If
End If
End Sub