Cell Selection, Border Changing
Option Explicit
Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim v(1 To 16, 1 To 3) As String
Dim rng1 As Range
Dim i As Long
v(1, 1) = "C9": v(1, 2) = "Sheet3": v(1, 3) = "B2:D2"
v(2, 1) = "C15": v(2, 2) = "Sheet3": v(2, 3) = "A1"
v(3, 1) = "C19": v(3, 2) = "Sheet3": v(3, 3) = "A1"
v(4, 1) = "C23": v(4, 2) = "Sheet3": v(4, 3) = "A1"
v(5, 1) = "C27": v(5, 2) = "Sheet3": v(5, 3) = "A1"
v(6, 1) = "C36": v(6, 2) = "Sheet3": v(6, 3) = "A1"
v(7, 1) = "H9": v(7, 2) = "Sheet4": v(7, 3) = "A1"
v(8, 1) = "H13": v(8, 2) = "Sheet4": v(8, 3) = "A1"
v(9, 1) = "H16": v(9, 2) = "Sheet4": v(9, 3) = "A1"
v(10, 1) = "H19": v(10, 2) = "Sheet4": v(10, 3) = "A1"
v(11, 1) = "H23": v(11, 2) = "Sheet4": v(11, 3) = "A1"
v(12, 1) = "H30": v(12, 2) = "Sheet4": v(12, 3) = "A1"
v(13, 1) = "M9": v(13, 2) = "Sheet5": v(13, 3) = "A1"
v(14, 1) = "M12": v(14, 2) = "Sheet5": v(14, 3) = "A1"
v(15, 1) = "M21": v(15, 2) = "Sheet5": v(15, 3) = "A1"
v(16, 1) = "M25": v(16, 2) = "Sheet5": v(16, 3) = "A1"
For i = 1 To 16
If Target.Address = Range(v(i, 1)).MergeArea.Address Then '(v(i,1) - the
first to the two numbers
Application.ScreenUpdating = False
Set rng1 = Sheets(v(i, 2)).Range(v(i, 3)) 'Select the new sheet/cell
range
Sheets(v(i, 2)).Select
rng1.Select
'
' make a name
'
selection.Name = "TargetArea"
'
'
'
ActiveWindow.Zoom = 87
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 41
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 41
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 41
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 41
End With
ActiveWindow.ScrollRow = rng1.Row
ActiveWindow.ScrollColumn = rng1.Column
Application.ScreenUpdating = True
Exit For
End If
' not sure why you are doing this here, but . . .
' Range("A1").Select
Range("B100").Select 'Places curser off screen
ActiveWindow.ScrollRow = 1
ActiveWindow.ScrollColumn = 1
Next
End Sub
' In the sheet module of the sheets you will select
Private Sub Worksheet_Deactivate()
Dim rng as Range
set rng = thisworkbook.Names("TargetArea")
With rng
With .Borders(xlEdgeLeft)
.LineStyle = xlNone
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeTop)
.LineStyle = xlNone
.ColorIndex = xlAuotmatic
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlNone
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeRight)
.LineStyle = xlNone
.ColorIndex = xlAutomatic
End With
End With
End Sub
--
Regards,
Tom Ogilvy
"Phil H" wrote in message
...
Tom and Otto,
Thanks for the wakeup call. Here's the code
Option Explicit
Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim v(1 To 16, 1 To 3) As String
Dim rng1 As Range
Dim i As Long
v(1, 1) = "C9": v(1, 2) = "Sheet3": v(1, 3) = "B2:D2"
v(2, 1) = "C15": v(2, 2) = "Sheet3": v(2, 3) = "A1"
v(3, 1) = "C19": v(3, 2) = "Sheet3": v(3, 3) = "A1"
v(4, 1) = "C23": v(4, 2) = "Sheet3": v(4, 3) = "A1"
v(5, 1) = "C27": v(5, 2) = "Sheet3": v(5, 3) = "A1"
v(6, 1) = "C36": v(6, 2) = "Sheet3": v(6, 3) = "A1"
v(7, 1) = "H9": v(7, 2) = "Sheet4": v(7, 3) = "A1"
v(8, 1) = "H13": v(8, 2) = "Sheet4": v(8, 3) = "A1"
v(9, 1) = "H16": v(9, 2) = "Sheet4": v(9, 3) = "A1"
v(10, 1) = "H19": v(10, 2) = "Sheet4": v(10, 3) = "A1"
v(11, 1) = "H23": v(11, 2) = "Sheet4": v(11, 3) = "A1"
v(12, 1) = "H30": v(12, 2) = "Sheet4": v(12, 3) = "A1"
v(13, 1) = "M9": v(13, 2) = "Sheet5": v(13, 3) = "A1"
v(14, 1) = "M12": v(14, 2) = "Sheet5": v(14, 3) = "A1"
v(15, 1) = "M21": v(15, 2) = "Sheet5": v(15, 3) = "A1"
v(16, 1) = "M25": v(16, 2) = "Sheet5": v(16, 3) = "A1"
For i = 1 To 16
If Target.Address = Range(v(i, 1)).MergeArea.Address Then '(v(i,1) - the
first to the two numbers
Application.ScreenUpdating = False
Set rng1 = Sheets(v(i, 2)).Range(v(i, 3)) 'Select the new sheet/cell
range
Sheets(v(i, 2)).Select
rng1.Select
ActiveWindow.Zoom = 87
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 41
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 41
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 41
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 41
End With
ActiveWindow.ScrollRow = rng1.Row
ActiveWindow.ScrollColumn = rng1.Column
Application.ScreenUpdating = True
Exit For
End If
Range("A1").Select , scroll:=True
Range("B100").Select , scroll:=False 'Places curser off screen
Next
End Sub
"Tom Ogilvy" wrote:
Fix what?
Use the sheet deactivate event to trigger and action when the user
leaves
the sheet.
--
Regards,
Tom Ogilvy
"Phil H" wrote:
This code works - when a user clicks a cell, they are taken to another
worksheet, and a cell range is given blue exterior borders. Then the
idea is
to position the worksheet relative to cell A1, then move the cursor
off-screen to B100.
Two problems:
1.) I can't make the A1, B100 code lines work.
2.) If the user moves off the worksheet, or exits, I want to restore
the
changed borders to thin/black.
Can someone help fix this?
Thanks, Phil
|