Highlight offset 8th row 3 values, from the selected cell

[motilulla]

Hello,

I requiresome solution to be highlighted offset 8th row 3 values, from the selected cell
Range to beselected in columns K:P, and highlighted range to be selected in columns C:H

For example...
If I selectK16, highlight the C14:C16
If I selectM31, "clear the highlighted range C14:C16" and highlight the E29:E31
If I selectP47, "clear the highlighted range E29:E31" and highlight the H45:H47

Note: ifselection is out of columns K:P, clear all highlights from columns C:G

Exampledata....

Book1
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q
1
2
3
4
5			n1	n2	n3	n4	n5	n6			n1	n2	n3	n4	n5	n6
6			30	11	13	42	18	4			3	0	4	5	4	2
7			29	27	45	33	19	38			2	1	2	4	2	2
8			23	4	6	5	22	33			1	1	1	4	3	3
9			2	12	45	12	47	27			2	1	1	3	2	4
10			46	35	18	8	21	12			2	1	1	2	3	4
11			35	21	37	45	1	47			3	1	1	2	4	4
12			18	15	32	9	2	27			1	3	0	2	4	2
13			38	11	46	5	13	9			2	3	1	3	4	2
14			45	4	2	30	9	38			2	5	2	4	2	2
15			45	10	18	6	3	10			3	3	2	4	2	4
16			3	16	22	21	1	46			3	2	1	4	2	5
17
18
19
20			n1	n2	n3	n4	n5	n6			n1	n2	n3	n4	n5	n6
21			30	11	13	42	18	4			3	0	4	5	4	2
22			29	27	45	33	19	38			2	1	2	4	2	2
23			23	4	6	5	22	33			1	1	1	4	3	3
24			2	12	45	12	47	27			2	1	1	3	2	4
25			46	35	18	8	21	12			2	1	1	2	3	4
26			35	21	37	45	1	47			3	1	1	2	4	4
27			18	15	32	9	2	27			1	3	0	2	4	2
28			38	11	46	5	13	9			2	3	1	3	4	2
29			45	4	2	30	9	38			2	5	2	4	2	2
30			45	10	18	6	3	10			3	3	2	4	2	4
31			3	16	22	21	1	46			3	2	1	4	2	5
32
33
34
35
36			n1	n2	n3	n4	n5	n6			n1	n2	n3	n4	n5	n6
37			30	11	13	42	18	4			3	0	4	5	4	2
38			29	27	45	33	19	38			2	1	2	4	2	2
39			23	4	6	5	22	33			1	1	1	4	3	3
40			2	12	45	12	47	27			2	1	1	3	2	4
41			46	35	18	8	21	12			2	1	1	2	3	4
42			35	21	37	45	1	47			3	1	1	2	4	4
43			18	15	32	9	2	27			1	3	0	2	4	2
44			38	11	46	5	13	9			2	3	1	3	4	2
45			45	4	2	30	9	38			2	5	2	4	2	2
46			45	10	18	6	3	10			3	3	2	4	2	4
47			3	16	22	21	1	46			3	2	1	4	2	5
48
49
Sheet1

Thank youall
Excel 2000
Regards,
Moti

 

[MickG]

Try:-

Private [COLOR="Navy"]Sub[/COLOR] Worksheet_SelectionChange(ByVal Target [COLOR="Navy"]As[/COLOR] Range)
[COLOR="Navy"]If[/COLOR] Not Intersect(Target, Columns("K:P")) [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
    [COLOR="Navy"]If[/COLOR] Target <> "" [COLOR="Navy"]Then[/COLOR]
        Target.Offset(-2, -8).Resize(3).Interior.Color = vbYellow
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]ElseIf[/COLOR] Intersect(Target, Columns("K:P")) [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
     Range("C:F").Interior.Color = xlNone
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[jim may]

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = "$K$16" Or _
   Target.Address = "$M$31" Or _
   Target.Address = "$P$47" Then
Application.EnableEvents = False
Target.Offset(-2, -8).Resize(3, 1).Select
Application.EnableEvents = True
End If
End Sub

 

[motilulla]

Try:-

Private [COLOR=Navy]Sub[/COLOR] Worksheet_SelectionChange(ByVal Target [COLOR=Navy]As[/COLOR] Range)
[COLOR=Navy]If[/COLOR] Not Intersect(Target, Columns("K:P")) [COLOR=Navy]Is[/COLOR] Nothing [COLOR=Navy]Then[/COLOR]
    [COLOR=Navy]If[/COLOR] Target <> "" [COLOR=Navy]Then[/COLOR]
        Target.Offset(-2, -8).Resize(3).Interior.Color = vbYellow
    [COLOR=Navy]End[/COLOR] If
[COLOR=Navy]ElseIf[/COLOR] Intersect(Target, Columns("K:P")) [COLOR=Navy]Is[/COLOR] Nothing [COLOR=Navy]Then[/COLOR]
     Range("C:F").Interior.Color = xlNone
[COLOR=Navy]End[/COLOR] If
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]

Regards Mick

Hello Mick, It's working perfect! Only when I select multiple cells in the range K:P highlights the following row in the code, is it possible avoid this error

If Target <> "" Then

Thank you for your help

Kind Regards,
Moti

 

[motilulla]

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = "$K$16" Or _
   Target.Address = "$M$31" Or _
   Target.Address = "$P$47" Then
Application.EnableEvents = False
Target.Offset(-2, -8).Resize(3, 1).Select
Application.EnableEvents = True
End If
End Sub

Hello jim may, I tried the code but it don't highlight any cells.

Please could you check?

Thank you for your help

Kind Regards,
Moti

 

[MickG]

Try this:-

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count = 1 Then
If Not Intersect(Target, Columns("K:P")) Is Nothing Then
    If Target <> "" Then
        Range("C:H").Interior.Color = xlNone
        Target.Offset(-2, -8).Resize(3).Interior.Color = vbYellow
    End If
ElseIf Intersect(Target, Columns("K:P")) Is Nothing Then
     Range("C:H").Interior.Color = xlNone
End If
End If
End Sub
Regrds Mick

 

[jim may]

Hello jim may, I tried the code but it don't highlight any cells.

Please could you check?

Thank you for your help

Kind Regards,
Moti

Note the code-line:
Target.Offset(-2, -8).Resize(3, 1).Select

Note the last word Select. This should HIGHLITE THE RANGE..

Step through the full code to view what happening with each code-line.

It works for me!!!

 

[motilulla]

Try this:-

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count = 1 Then
If Not Intersect(Target, Columns("K:P")) Is Nothing Then
    If Target <> "" Then
        Range("C:H").Interior.Color = xlNone
        Target.Offset(-2, -8).Resize(3).Interior.Color = vbYellow
    End If
ElseIf Intersect(Target, Columns("K:P")) Is Nothing Then
     Range("C:H").Interior.Color = xlNone
End If
End If
End Sub
Regrds Mick

Mick, Yes that's exactly as I wanted, it's perfect!

Thanks a lot once again!!

Kind Regards,
Moti

 

[motilulla]

Note the code-line:
Target.Offset(-2, -8).Resize(3, 1).Select

Note the last word Select. This should HIGHLITE THE RANGE..

Step through the full code to view what happening with each code-line.

It works for me!!!

Sorry jim may, yes it is working if I select the ranges as I specified in the example post#1, because I did not clarified and selection in the range K:P

Thank you for the clarification and help

Kind Regards,
Moti

 

[Rick Rothstein]

Mick, Yes that's exactly as I wanted, it's perfect!

Is it? I presumed if you selected a cell near the top of the right-hand filled range, or if you selected a cell in the title row itself, that you would not want the selection in the other filled range to color the title row or blank cells above it. Mick's code colors those cells for such a selection... the following SelectChange event accounts doesn't.

[table="width: 500"]
[tr]
	[td]Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim TopRow As Long, Cell As Range, Rng As Range, IntersectRng As Range
  Range("C:H,K:P").Interior.ColorIndex = xlColorIndexNone
  Set Rng = Intersect(Target, Columns("K:P"))
  If Not Rng Is Nothing Then
    TopRow = Rng.CurrentRegion.Row
    For Each Cell In Rng
      If IsNumeric(Cell.Value) And Cell.Value <> "" Then
        Cell.Interior.Color = vbYellow
        Intersect(Cell.CurrentRegion.Offset(1, -8), Cell.Offset(-2, -8).Resize(3)).Interior.Color = vbYellow
      End If
    Next
  End If
End Sub[/td]
[/tr]
[/table]