May 27 2022 03:46 AM
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 opended.
Its like when we save the code in the Personal.XLSB and it works for every new workbook.
I would appreciate if you could help me in this regards.
Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Static xRow
If xRow <> "" Then
With Rows(xRow).Interior
.ColorIndex = xlNone
End With
End If
Active_Row = Selection.Row
xRow = Active_Row
With Rows(Active_Row).Interior
.ColorIndex = 3
.Pattern = xlSolid
End With
End Sub
May 27 2022 04:34 AM
SolutionThe 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
May 27 2022 04:34 AM
SolutionThe 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