#1
|
|||
|
|||
Worksheet_SelectionChange
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 |
#2
|
|||
|
|||
Never mind, I found that Application.EnableEvents = "true/false" does what I need, the rest of the logic I'll figure out.
|
#3
|
|||
|
|||
If anybody has any ideas on how to improve this let me know
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 |
#4
|
|||
|
|||
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 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 |
#5
|
|||
|
|||
Can you attach a sample workbook ?
|
#6
|
|||
|
|||
I can do that on Wednesday, when im back at work.
|
#7
|
|||
|
|||
Sample Excel file attachad
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. |
#8
|
|||
|
|||
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 Code:
Application.ScreenUpdating = True Last edited by NoSparks; 09-04-2018 at 02:22 PM. Reason: added for ScreenUpdating |
#9
|
|||
|
|||
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 |