Change worksheet tab color if sheet is NOT empty

[Ruckus]

I have a workbook with an 'Additional Info' sheet at the end of the book.

My problem is that info is only entered on to this sheet about 5% of the time and I end up missing it because it's not common.

I've searched these forums, googled and attempted to modify code for hours now without success.

What would the VBA code be to change the color of the tab if anything is entered into any cell of that sheet

 

[VoG]

Try this: right click the sheet tab, select View Code and paste in

Private Sub Worksheet_Change(ByVal Target As Range)
If WorksheetFunction.CountA(Me.Cells) <> 0 Then Me.Tab.Color = RGB(255, 0, 0)
End Sub

 

[Ruckus]

That works

Though if they enter a value and then remove it, it remains colored. Is there a way of changing it back to 'no color' if they enter something then change their mind and delete?

 

[AlphaFrog]

Private Sub Worksheet_Change(ByVal Target As Range)
    If Cells.Find("*") Is Nothing Then
        ActiveSheet.Tab.ColorIndex = xlNone
    Else
        ActiveSheet.Tab.ColorIndex = 3
    End If
End Sub

 

[VoG]

Maybe this

Private Sub Worksheet_Change(ByVal Target As Range)
Me.Tab.Color = xlnone
If WorksheetFunction.CountA(Me.Cells) <> 0 Then Me.Tab.Color = RGB(255, 0, 0)
End Sub

 

[Ruckus]

For some reason when I tried AlphaFrog's code it would color other tabs if I clicked them before clicking somewhere else in the 'Additional Info' tab.

Strange!


VoG: That works! Thank you once again.

 

[Ruckus]

Oops! If I share the workbook, the code no longer works and I receive an error message if I attempt to enter anything in that sheet.

"Run-Time Error '1004':

application-defined or object-defined error"


From Microsoft: 'This issue may occur if one or more of the cells in an array (range of cells) contain a character string that is set to contain more than 911 characters.'

Private Sub Worksheet_Change(ByVal Target As Range)
Me.Tab.Color = xlNone
If WorksheetFunction.CountA(Me.Cells) <> 0 Then Me.Tab.Color = RGB(255, 0, 0)
End Sub