Forum Discussion

ShazSh's avatar
ShazSh
Brass Contributor
May 27, 2022
Solved

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 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
excel
Macros and VBA
  • HansVogelaar's avatar
    HansVogelaar
    May 27, 2022

    ShazSh 

    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

     

2 Replies

Sort By
  • HansVogelaar's avatar
    HansVogelaar
    MVP
    May 27, 2022

    ShazSh 

    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

     

Resources