At my new job I’ve been working with Excel & VBA Script. Something I’ve not really done before.
I wanted the ability to highlight the row of the active cell. Makes for easier data entry. A number of examples are out on the web. However, most involve simply highlighting the entire row and clearing all highlights upon loss of focus.
Problem is, that system removes any highlights you might actually be using. After a bit of wrangling I came up with the following code which checks on a cell level to see if a highlight exists. And only highlights the cell if one does not.
It’s not a perfect macro. I haven’t tested to confirm loss of “undo” (a common issue with macros affecting worksheets in Excel for some unknown reason). The highlight will also fail to work if there is background coloring on your worksheet. But if those are not a concern to you, this might be a solution.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Static oldRange As String 'Stores old range
oldRange = "A1:CW100"
Dim cN As Object
'If an old range exists, remove highlight before during active selection
If (oldRange <> "") Then
'For each cell in row loop and reset color IF highlight color
For Each cN In Worksheets("worksheet").Range(oldRange).Cells
If (cN.Interior.ColorIndex = 24) Then
cN.Interior.ColorIndex = xlColorIndexNone
cN.Borders.ColorIndex = xlColorIndexNone
End If
Next cN
End If
'Create and store range
oldRange = "A" & ActiveCell.Row & ":CW" & ActiveCell.Row 'Stuff range into old range for future removal
Dim cNum As Object
'Loop over all cells in activecell row. Highlight IF not already highlighted
For Each cNum In Worksheets("worksheet").Range("A" & ActiveCell.Row & ":CW" & ActiveCell.Row).Cells
If (cNum.Interior.ColorIndex = -4142) Then
cNum.Interior.ColorIndex = 24
cNum.Borders.ColorIndex = 2
End If
Next cNum
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Static oldRange As String 'Stores old range
oldRange = "A1:CW100"
Dim cN As Object
'If an old range exists, remove highlight before during active selection
If (oldRange <> "") Then
'For each cell in row loop and reset color IF highlight color
For Each cN In Worksheets("worksheet").Range(oldRange).Cells
If (cN.Interior.ColorIndex = 24) Then
cN.Interior.ColorIndex = xlColorIndexNone
cN.Borders.ColorIndex = xlColorIndexNone
End If
Next cN
End If
'Create and store range
oldRange = "A" & ActiveCell.Row & ":CW" & ActiveCell.Row 'Stuff range into old range for future removal
Dim cNum As Object
'Loop over all cells in activecell row. Highlight IF not already highlighted
For Each cNum In Worksheets("worksheet").Range("A" & ActiveCell.Row & ":CW" & ActiveCell.Row).Cells
If (cNum.Interior.ColorIndex = -4142) Then
cNum.Interior.ColorIndex = 24
cNum.Borders.ColorIndex = 2
End If
Next cNum
End Sub
