Worksheet_SelectionChange

trevorc · #4 08-30-2018, 09:04 PM

Hi Again, I have update my code to make it a bit neater and also use a command button to turn on/off the highlighting option.

I am having trouble getting the code to return the cursor to the last position after turning of highlighting, any help would be great. See new code below...

Command button code

Code:

Sub Macro9()
    If Sheets("Automation Data").Range("D13") = 1 Then          'turn on highlighting
       ActiveSheet.Shapes("TB3").TextFrame.Characters.Text = "Turn OFF" & vbCrLf & "Highlighting"
       Sheets("Automation Data").Range("D13") = 2
    Else                                                        ' turn off highlighting
       ActiveSheet.Shapes("TB3").TextFrame.Characters.Text = "Turn ON" & vbCrLf & "Highlighting"
       Sheets("Automation Data").Range("D13") = 1
       'restore current row highlighting
       Sheets("Automation Data").Range("A55", "AL55").Copy
       Range("A" & Sheets("Automation Data").Range("D14").Value, "AL" & Sheets("Automation Data").Range("D14").Value).Select
       Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
       Application.CutCopyMode = False
    End If
 End Sub

highlight row code

Code:

Function InRange(Range1 As Range, Range2 As Range) As Boolean
    InRange = Not (Application.Intersect(Range1, Range2) Is Nothing)
End Function
Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
On Error Resume Next
If InRange(ActiveCell, Range("Header_Rows")) Then Exit Sub
If Selection.Row = Sheets("Automation Data").Range("D16").Value Then Exit Sub
   Application.EnableEvents = False
   current_cell = ActiveCell.Address
   Sheets("Automation Data").Range("D16").Value = Selection.Row
If Sheets("Automation Data").Range("D13").Value = 1 Then
   Application.EnableEvents = True
   Exit Sub
Else
'restore previous row formmatting
   Sheets("Automation Data").Range("A55", "AL55").Copy
   Range("A" & Sheets("Automation Data").Range("D14").Value, "AL" & Sheets("Automation Data").Range("D14").Value).Select
   Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
   Application.CutCopyMode = False
   Range("A" & Sheets("Automation Data").Range("D16"), "AL" & Sheets("Automation Data").Range("D16")).Select
' save current row formatting
   Sheets("Automation Data").Range("D16") = Selection.Row
   Range("A" & Sheets("Automation Data").Range("D16"), "AL" & Sheets("Automation Data").Range("D16")).Copy
   Sheets("Automation Data").Range("A55", "AL55").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
   Application.CutCopyMode = False
'highlight current row
   Range("A" & Sheets("Automation Data").Range("D16"), "AL" & Sheets("Automation Data").Range("D16")).Interior.ColorIndex = Sheets("Automation Data").Range("D15")
   Application.CutCopyMode = False
   Range(current_cell).Select
   Application.EnableEvents = True
   Sheets("Automation Data").Range("D14").Value = Selection.Row
End If
End Sub

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Convert a worksheet_SelectionChange to WorkBook_SheetChange macro	sparkle	Excel Programming	2	08-03-2014 02:26 AM