Cell Selection, Border Changing

[Guest]

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

 

[Guest]

Fix what?

Use the sheet deactivate event to trigger and action when the user leaves
the sheet.

 

[Otto Moehrbach]

You didn't include your code in your post. HTH Otto

 

[Guest]

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) = "B22"
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]

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) = "B22"
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