Changing Excel worksheet tab colours from VBS

I don’t think this is possible, but I thought I’d ask just in case you guys have come across it before, but you can manually change the tab colours in a workbook, but can you do it via VBS to meet certain criteria (this is in Office XP version of Excel).

I have a workbook that we use to allocate hours per day and when the maximum is reached a cell shows FULL via an IF statement. Is there a way of running a VB script so that when that cell shows FULL the sheet tab turns red? It would need to run at timed intervals as well, so that it is constantly updating during the day although this might be arranged manually. Is it possible?

I know an active sheet can not sure about other tabs… just done a google for you based on that so hopefully useful info contained within…

http://64.233.183.104/search?q=cache:_7saHRcFyvoJ:www.excelforum.com/showthread.php%3Ft%3D391215+vbs+excel+tab+colour&hl=en&ct=clnk&cd=2&gl=uk&client=firefox-a

You can also use color (tested in Excel 2007):
worksheets(1).tab.color = rgb(0,100,0)

As for the timed intervals, could you use something in the change event of the worksheet? After all, the tab will only change colour if something on one of the sheets changes.

That looks like the sort of thing I’ll need. Now all I need is an IF statement to check the cell. Thanks Paul.

@ Kevin. Not sure about that. My knowledge is a little sketchy, but I’ll have a play.

Couldn’t do anything with it last night, cause my home version of Excel won’t allow tab colour changes, but I played with it at work and this scenario works when the macro is run manually.


Sub Tabcolour()
'
' Tabcolour Macro
' Macro recorded 12/02/2008 by Andy Young
'

'
    Sheets("1st").Select
    Range("B22:C22").Select ' is centred over 2 cells, hence the range
    If ActiveCell.value = "FULL" Then
    ActiveWorkbook.Sheets("1st").Tab.ColorIndex = 3
    Else
    ActiveWorkbook.Sheets("1st").Tab.ColorIndex = 45
    End If
End Sub

This needs to be set up to run for every tab (31 for a whole month like January) so is it possible to set a For …Next loop to change every tab or do I have to write each tab individually into the macro?

Something like this works in Excel 2003


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If Sh.Range("A1").Value > 200 Then
      Sh.Tab.Color = RGB(100, 0, 0)
    Else
      Sh.Tab.Color = RGB(0, 100, 100)
    End If
End Sub

Thanks Kevin. Tried it in Excel 2002 and can’t seem to get it to work. Changed it from Private Sub to Sub and pasted it into a separate module, but I can’t see it as a macro to attach to a button. Does not show in the macro list.

It needs to be pasted into thisWorkbook, not the worksheet and not a module.
If you look at the workbook events, do you have SheetChange?

The above will affect every worksheet. You could paste something similar into an individual worksheet Change event if you just wanted to affect one worksheet.

Thanks for that Kevin. Pasted it into ThisWorkbook and changed the cell and I can see SheetChange in the workbook events listing.

I changed the cell value to the cell with the “FULL” formula value in it so it now reads:


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If Sh.Range("B22").value = "FULL" Then
      Sh.Tab.Color = RGB(100, 0, 0)
    Else
      Sh.Tab.Color = RGB(0, 100, 100)
    End If
End Sub

This works OK but only with cell B22. With the range selected, I change a value in the a cell that affects the target cell, I get Run Time Error 13 and when I debug it, it highlights “If Sh.Range(“B22:C22”).value = “FULL” Then”

The IF statement is in the same cell on every sheet, so I changed the Sh.Range to just B22 and it works OK in every sheet. As the formula spans both B22 and C22, any ideas why this happens?

My Excel VBA is long forgotton but if you had a piece of code to notice the change then refresh the spreadsheets I think it will work with the below having Sheet2 looking at a cell referenced in sheet 1 but the change will not occur to the tab until a refresh takes place or you enter a value in another cell on the 2nd sheet.


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If Sh.Name = "Sheet2" And Sh.Range("B22").Value = "FULL" Then
      Sh.Tab.Color = RGB(100, 0, 0)
    Else
      Sh.Tab.Color = RGB(0, 100, 100)
    End If
End Sub

Thanks Paul. I tried that, but it doesn’t work unfortunately. Kevin’s solution works fine and I’ve made some minor changes to fix some issues and so far it all seems OK. I’ll post the sheet for you to peruse in case there are some mods or better ways of doing things that you can suggest. Thanks for all your help guys. :thumbsup:

Grrrr!! Sometimes I hate Excel…

The main reason for this project was that the guys on Reception could all add detail to the sheet and save it, so it is kept constantly up to date. Unfortunately when you save the workbook as a shared book and try to add detail it keeps coming up with a “Run Time Error 1004” which apparently is a known Excel bug :realmad: So after all that faffing, although my knowledge has increased the tab colour change does not work… Oh well.

There is a workaround, but I’m so dis-chuffed with it, I can’t be @rsed. I’ve given up for tonight and I’ll revisit it again tomorrow. :frowning:

Only tried in Excel 2007:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If Application.WorksheetFunction.CountIf(Sh.Range("B22:B23"), "FULL") > 0 Then
      Sh.Tab.Color = RGB(100, 0, 0)
    Else
      Sh.Tab.Color = RGB(0, 100, 100)
    End If
End Sub

Thanks Kevin. That works OK in Excel 2002 as well. After I share the workbook I still get the “Run-time error ‘1004’: Application-defined or object-defined error”, which is a known problem with Excel according to the MS knowledge base and the fix is too long-winded to sort out.

I’ve got around it with a button link page, macros and conditional formatting to give an on-screen as opposed to an on-tab visual note when a booking date is full. I’ll keep that Private sub in mind for next time though. thanks for all your help. :thumbsup: