Worksheet_SelectionChange

trevorc · #1 08-23-2018, 05:34 PM

Hi All,
I am trying to make the current row being edited highlighted using the selection change event, what I have to do is first save the current row's cell formats (in say A1000:AM1000), then highlight the row, if I stay on that row do nothing and if I select another row restore the previous rows formatting, then highlight the new row.
Is there a way to stop the code from running every time the selection changes or do I need VBA to handle selecting the row to paste the current rows formatting then returning to the selected row, without the code trying to run again.
I have made a start on the code but got stumped debugging the re-running of the code before the sub finished, even in VBA selecting another row fires off the selection change event again. Any help is appreciated.

Code:

'Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
'H_Row = Selection.Row
'Range("A" & H_Row, "AL" & H_Row).Select
'   Selection.Copy
'   Range("A70").Select
'   Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'Range("AJ1") = 6 'Selection.Interior.ColorIndex
'End Sub

trevorc · #2 08-23-2018, 09:11 PM

Never mind, I found that Application.EnableEvents = "true/false" does what I need, the rest of the logic I'll figure out.

trevorc · #3 08-26-2018, 06:31 PM

So Here's my finished code to highlight a row in Yellow, then return any formatting that row when selecting another row. If anybody has any ideas on how to improve this let me know

Code:

Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
'Exit Sub
On Error Resume Next
Application.EnableEvents = False
current_cell = ActiveCell.Address
previous_row = Range("AC3").Value
C_Row = Selection.Row
If Selection.Row = Range("AB1").Value Then
   Application.EnableEvents = True
   Exit Sub
Else
'restore previous row formmatting
   Range("A78", "AL78").Select
   Selection.Copy
   Range("A" & Range("AC3").Value, "AL" & Range("AC3").Value).Select
   Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
   Application.CutCopyMode = False
   Range("A" & C_Row, "AL" & C_Row).Select
' save current row formatting
   C_Row = Selection.Row
   Range("A" & C_Row, "AL" & C_Row).Select
   Selection.Copy
   Range("A78").Select
   Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
   Application.CutCopyMode = False
'highlight current row
   Range("A" & C_Row, "AL" & C_Row).Interior.ColorIndex = 6
   Range("AJ1") = 6 'Selection.Interior.ColorIndex
   Range("A" & C_Row, "AL" & C_Row).Select
Range(current_cell).Select
Application.EnableEvents = True
Range("AB1").Value = Selection.Row
   Application.CutCopyMode = False
   Range("AC3").Value = Selection.Row
End If
End Sub

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

NoSparks · #5 08-31-2018, 09:33 AM

Can you attach a sample workbook ?

trevorc · #6 08-31-2018, 02:39 PM

I can do that on Wednesday, when im back at work.

trevorc · #7 09-04-2018, 12:51 PM

Hi All,
Here's the sample Workbook, the issue I have is when turning off the highlight feature the cursor is set to the last entire row selected, I need the last cell active to be selected. It seems everything else works how I like it. The code controlling this is the button click event (Turn on/Off Highlighting) Macro9() in Module7

All sensitive data has been removed.

NoSparks · #8 09-04-2018, 01:55 PM

selecting where to paste the formatting back in is causing the SelectionChange to fire and leaving the row selected
try this

Code:

Sub Macro9()
  curcel = ActiveCell.Address(0, 0)
    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
       Application.EnableEvents = False     'disable events
       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
       Range(curcel).Select                 'select original cell
       Application.EnableEvents = True      'reenable events
       Application.CutCopyMode = False
    End If
 End Sub

You should also put

Code:

Application.ScreenUpdating = False

at the beginning of Worksheet_SelectionChange and

Code:

Application.ScreenUpdating = True

at the end to stop screen flicker.

trevorc · #9 09-04-2018, 03:03 PM

Thanks for the prompt reply, I'll try out your suggestions later today, I'm swamped with work after taking 2 days off.

regards
Trevor

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