Forum Discussion
ShazSh
May 27, 2022Brass Contributor
Highlight Row for Entire and other workbooks
I am using this code which is working fine but this code is only works for the single sheet. I am trying to find a way to apply this code to the entire workbook and to any workbook that i have opende...
- May 27, 2022
The code would need to remember xRow for each sheet separately. If you are on Windows, you could copy the following code into the ThisWorkbook module of your personal macro workbook PERSONAL.XLSB (or of an add-in). Restart Excel after that. Make sure that you save PERSONAL.XLSB when prompted to do so.
Dim WithEvents app As Application Dim dct As Object Private Sub app_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) If GetDct.Exists(Sh) Then With Sh.Rows(GetDct(Sh)).Interior .ColorIndex = xlNone End With End If GetDct(Sh) = Target.Row With Sh.Rows(Target.Row).Interior .ColorIndex = 3 .Pattern = xlSolid End With End Sub Private Sub Workbook_BeforeClose(Cancel As Boolean) Set app = Nothing Set dct = Nothing End Sub Private Sub Workbook_Open() Set app = Application End Sub Private Function GetDct() As Object If dct Is Nothing Then Set dct = CreateObject("Scripting.Dictionary") End If Set GetDct = dct End Function
HansVogelaar
May 27, 2022MVP
The code would need to remember xRow for each sheet separately. If you are on Windows, you could copy the following code into the ThisWorkbook module of your personal macro workbook PERSONAL.XLSB (or of an add-in). Restart Excel after that. Make sure that you save PERSONAL.XLSB when prompted to do so.
Dim WithEvents app As Application
Dim dct As Object
Private Sub app_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If GetDct.Exists(Sh) Then
With Sh.Rows(GetDct(Sh)).Interior
.ColorIndex = xlNone
End With
End If
GetDct(Sh) = Target.Row
With Sh.Rows(Target.Row).Interior
.ColorIndex = 3
.Pattern = xlSolid
End With
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Set app = Nothing
Set dct = Nothing
End Sub
Private Sub Workbook_Open()
Set app = Application
End Sub
Private Function GetDct() As Object
If dct Is Nothing Then
Set dct = CreateObject("Scripting.Dictionary")
End If
Set GetDct = dct
End Function
ShazSh
May 27, 2022Brass Contributor
Thank you very much.