PDA

View Full Version : [SOLVED:] Help : Highlight the row basis of a cell selection and restore on selectin change



anish.ms
07-11-2021, 12:07 PM
Hi,

I have written the below code to highlight a row range based on a cell selection and restore back to default format on selection change. Request your support on the below-

(1) Can I just restore the previous selection instead of restoring the entire data range
(2) I also want to highlight the multiple selection



Private Sub Worksheet_SelectionChange(ByVal Target As Range)
ay = Target.Row
ax = Target.Column
If (ay > 1 And ay <= rowLastTracker) And ax < 9 Then
Application.ScreenUpdating = False
Application.EnableEvents = False
Call restoreformat
Call customformat
Application.EnableEvents = True
Application.ScreenUpdating = True
End If
End Sub






Sub customformat()
With Range("A" & ay & ":H" & ay)
.Borders(xlEdgeTop).Weight = xlMedium
.Borders(xlEdgeTop).Color = RGB(62, 188, 222)
.Borders(xlEdgeBottom).Weight = xlMedium
.Borders(xlEdgeBottom).Color = RGB(62, 188, 222) 'RGB(79, 194, 225) 'RGB(73, 205, 184)
.Font.Bold = True
End With
With Range("A" & ay & ":D" & ay)
.Font.Color = RGB(20, 77, 146)
End With
End Sub


Sub restoreformat()
With Range("A2:" & "H" & rowLastTracker)
.Borders(xlInsideHorizontal).Color = vbWhite
.Borders(xlInsideHorizontal).Weight = xlThick
.Font.Bold = False
End With
With Range("A2:" & "D" & rowLastTracker)
.Font.Color = vbBlack
End With
End Sub


Thanks in Advance!

SamT
07-11-2021, 09:29 PM
Neither CustomFormat nor RestoreFormat reference any worksheet. And RowLastTracker references ReviewTracker, not Dashboard.
Delete CustomFormat and RestoreFormat from Module mod_Utility.

Replace the Dashboard codes with

Option Explicit

Private PreviousChange As Range

'
' Activate here
' Before Doubleclick here
'

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Row = 1 Then Exit Sub
If Target.Column < 9 Then
Application.ScreenUpdating = False
Application.EnableEvents = False
restoreformat Target
customformat Target
Application.EnableEvents = True
Application.ScreenUpdating = True
End If
End Sub

Sub customformat(ByVal Target As Range)
With Rows(Target.Row).Range("A:H")
.Borders(xlEdgeTop).Weight = xlMedium
.Borders(xlEdgeTop).Color = RGB(62, 188, 222)
.Borders(xlEdgeBottom).Weight = xlMedium
.Borders(xlEdgeBottom).Color = RGB(62, 188, 222) 'RGB(79, 194, 225) 'RGB(73, 205, 184)
.Font.Bold = True
End With
With Rows(Target.Row).Range("A:D")
.Font.Color = RGB(20, 77, 146)
End With
End Sub

Sub restoreformat(ByVal Target As Range)
If not PreviousChange is Nothing then
With Rows(PreviousChange.Row).Range("A:H")
.Borders(xlEdgeTop).Weight = xlThick
.Borders(xlEdgeTop).Color = RGB(62, 188, 222)
.Borders(xlEdgeBottom).Weight = xlThick
.Borders(xlEdgeBottom).Color = RGB(62, 188, 222)
.Font.Bold = False
.Font.Color = vbBlack
End With
End if
Set PreviousChange = Target
End Sub

anish.ms
07-11-2021, 10:27 PM
Thanks Sam for your time and help!
I have replaced the codes with the one you suggested but getting run time error (Application-defined or object-defined error) in the following line


With Rows(Target.Row).Range("A:H")

SamT
07-12-2021, 07:22 AM
This time I tested the code. And added multi-select capabilities. Let me know what you think
Option Explicit

Private PreviousChange As Range

'
' Activate here
' Before Doubleclick here
'


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count = 1 And Target.Row = 1 Then Exit Sub
If Target.Column < 9 Then
restoreformat Target
customformat Target
End If
End Sub



Sub customformat(ByVal Target As Range)
Application.ScreenUpdating = False
Application.EnableEvents = False

Dim Cel As Range
For Each Cel In Target
If Cel.Row = 1 Then GoTo CelNext
With Intersect(Rows(Cel.Row), Range("A:H"))
.Borders(xlEdgeTop).Weight = xlMedium
.Borders(xlEdgeTop).Color = RGB(62, 188, 222)
.Borders(xlEdgeBottom).Weight = xlMedium
.Borders(xlEdgeBottom).Color = RGB(62, 188, 222) 'RGB(79, 194, 225) 'RGB(73, 205, 184)
.Font.Bold = True
End With

With Intersect(Rows(Cel.Row), Range("A:D"))
.Font.Color = RGB(20, 77, 146)
End With
CelNext:
Next Cel
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub



Sub restoreformat(ByVal Target As Range)
Application.ScreenUpdating = False
Application.EnableEvents = False

Dim Cel As Range

If Not PreviousChange Is Nothing Then
For Each Cel In PreviousChange
If Cel.Row = 1 Then GoTo CelNext
With Intersect(Rows(Cel.Row), Range("A:H"))
.Borders.LineStyle = xlNone
.Font.FontStyle = "Regular"
End With
CelNext:
Next Cel
End If
Set PreviousChange = Target
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

anish.ms
07-12-2021, 11:13 AM
Thanks Sam!
Perfectly working

anish.ms
07-12-2021, 12:11 PM
I have got a problem (excel gets stuck) if I select the entire column from the column header within Target.Column < 9
To avoid that I have added the below code


If Selection.Count > 100 Then Exit Sub

SamT
07-12-2021, 01:18 PM
:thumb

But, why would you want to highlight every row on the sheet?

Anyway, if you ever expect to need more than 100 rows

If Target Is Target.EntireColumn then Exit sub Should work.

One issue I saw, but ignored since it was not in your requirements: Once a row, or more, is selected/formatted, there is no way to "unselect/Restore" all selections. Methinks that would require a new sub procedure ran from the Macro menu. Possibly by Double Clicking a cell other than a Header.

That new procedure would be identical to the RestoreFormat sub , Except, no Target input Parameter, and the last line would set PreviousChange to Nothing

anish.ms
07-12-2021, 07:59 PM
Thanks Sam!
I'm thinking to select a cell out of the highlighted row (A:H) to have a better look
something like below

28730

Cells(Cel.Row, 10).Select
28731

SamT
07-13-2021, 07:14 AM
???