Can I do this in Excel, or another program?

April 6, 2021 6:28 PM

I'm trying to create some formatting in Excel so that a cell can be highlighted with a click to show what each person is working on. Kind of like an extended office In/Out board. I've got some VBA set up, but it's only allowing me one highlighted cell in the whole range and I want each row (person) to have its own highlighted cell.

I copied and modified this from another board and don't know how to write VBA from scratch, so I've made a mistake somewhere. How do I modify this to have one highlighted cell per row/range?

=============

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Static Cl As Range

If Not Intersect(Target, Range("B2:H2")) Is Nothing Then
With Target.Interior
.ColorIndex = IIf(.ColorIndex = 8, 0, 8)
End With
If Not Cl Is Nothing Then Cl.Interior.ColorIndex = 0
Set Cl = Target
End If


If Not Intersect(Target, Range("B3:H3")) Is Nothing Then
With Target.Interior
.ColorIndex = IIf(.ColorIndex = 8, 0, 8)
End With
If Not Cl Is Nothing Then Cl.Interior.ColorIndex = 0
Set Cl = Target
End If


If Not Intersect(Target, Range("B4:H4")) Is Nothing Then
With Target.Interior
.ColorIndex = IIf(.ColorIndex = 8, 0, 8)
End With
If Not Cl Is Nothing Then Cl.Interior.ColorIndex = 0
Set Cl = Target
End If


End Sub

=======================

posted by mefireader to Computers & Internet (3 answers total)

Would something like "Intersect Operator" work for you? Scroll down just over half the page to the section called "A Practical Example of Using Intersect Operator in Excel". If the example they show is usable for you then you'll have to read the whole thing to see how it works.
posted by ashbury at 7:24 PM on April 6, 2021

Best answer: I think this does what you're looking for:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim RangePerson1 As Range
Set RangePerson1 = Range("B2:H2")
Dim RangePerson2 As Range
Set RangePerson2 = Range("B3:H3")
Dim RangePerson3 As Range
Set RangePerson3 = Range("B4:H4")

If Target.Count > 1 Then Exit Sub

If Not Intersect(Target, RangePerson1) Is Nothing Then
RangePerson1.Interior.ColorIndex = 0
Target.Interior.ColorIndex = 3
End If

If Not Intersect(Target, RangePerson2) Is Nothing Then
RangePerson2.Interior.ColorIndex = 0
Target.Interior.ColorIndex = 3
End If

If Not Intersect(Target, RangePerson3) Is Nothing Then
RangePerson3.Interior.ColorIndex = 0
Target.Interior.ColorIndex = 3
End If

End Sub

You'll need to add additional ranges and If statements if you have more than 3 folks and modify the ranges as needed for additional columns / tasks. There may be a way of automating that based on what's in the sheet but I didn't delve that deeply.
posted by macfly at 7:31 PM on April 6, 2021

Response by poster: Thank you, macfly, that is it. Brilliant. And thank you ashbury for the suggestion.
posted by mefireader at 8:25 PM on April 6, 2021