Calendar Dynamic Color Cell - VBA

**royUK** · Jun 23rd 2021

It will, I should have used.

I don't understand why you want to though.

The full code made the sheet visible because it was hidden, then at the end of the process made it hidden again.

pantakos · Jun 23rd 2021

You are absolutely right. The code as it is , its more than fine.
One last thing (I hope because I droit want to bother you), is it possible when the range B3:E5 or / and range B10:E12 of the newly created tab , is not complete (filled with data any of the cells in ranges) the tab color to be , green and when the ranges are complete to be red?

Thank you again !

**royUK** · Jun 23rd 2021

Youwould need to do that with Conditional Formatting

pantakos · Jun 23rd 2021

I will do that!

If I do that at table tab it will work to all newly created tabs , right?

Thank you!

**royUK** · Jun 23rd 2021

That's correct

pantakos · Jun 23rd 2021

royUK can you please help me again?

The below code will change color of the tab bases if some cells are empty.

I am not good with ranges, so besides the range B3:E5 I need to also check range B10:E12 , how can I combined the two ranges?

Thank you

I attach the file and the code

CalendarCAFE.xlsm

Code

Private Sub Workbook_Open()

        Dim sheet As Worksheet
        For Each sheet In Me.Worksheets
        SetTabColor sheet
    Next sheet

End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    If Not Intersect(Target, Sh.Range("B3:E5")) Is Nothing Then
      SetTabColor Sh
     End If
 End Sub

Private Sub SetTabColor(sheet As Worksheet)

    Dim cell As Range
    Dim bIsEmpty As Boolean
  For Each cell In Range("B3:E5")
    If IsEmpty(cell) = True Then
        bIsEmpty = True
       Exit For
    End If
Next cell

If bIsEmpty = True Then
        sheet.Tab.Color = vbYellow
    Else
        sheet.Tab.Color = vbRed
        MsgBox "You can now save the file"
    End If
End Sub

Display More

**royUK** · Jun 24th 2021

Try this

Code

If Not Intersect(Target, Union(Sh.Range("B3:E5"), Sh.Range("B10:E12"))) Is Nothing Then

pantakos · Jun 24th 2021

thank you for your reply. I will try it and let you know. One question, what about this piece of code that checks each cell , should I change that also?

Code

 For Each cell In Range("B3:E5")
 If IsEmpty(cell) = True Then
 bIsEmpty = True

Thank you!

**royUK** · Jun 24th 2021

Try this

Code

Private Sub Workbook_Open()
    Dim sheet As Worksheet
    For Each sheet In Me.Worksheets
        SetTabColor sheet
    Next sheet
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If Not Intersect(Target, Union(Sh.Range("B3:E5"), Sh.Range("B10:E12"))) Is Nothing Then
        SetTabColor Sh
    End If
End Sub
Private Sub SetTabColor(sheet As Worksheet)
    Dim cell As Range
    Dim bIsEmpty As Boolean
    
    For Each cell In Union(sheet.Range("B3:E5"), sheet.Range("B10:E12")).Cells
        If IsEmpty(cell) = True Then
            bIsEmpty = True
            Exit For
        End If
    Next cell
    
    If bIsEmpty = True Then
        sheet.Tab.Color = vbYellow
    Else
        sheet.Tab.Color = vbRed
        MsgBox "You can now save the file"
    End If
End Sub

Display More

This might be better.

Code

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If Not Intersect(Target, Union(Sh.Range("B3:E5"), Sh.Range("B10:E12"))) Is Nothing Then
        SetTabColor Sh
    End If
End Sub
Private Sub SetTabColor(sheet As Worksheet)
    Dim cell As Range, rRng As Range
    Dim bIsEmpty As Boolean
    
    Set rRng = Union(sheet.Range("B3:E5"), sheet.Range("B10:E12"))
    
    On Error Resume Next
    If rRng.Sp.SpecialCells(xlCellTypeConstants).Count = rRng.Cells.Count Then
        sheet.Tab.Color = vbYellow
        Else: sheet.Tab.Color = vbRed
    End If
    On Error GoTo 0
    
    MsgBox "You can now save the file"
End Sub

Display More

pantakos · Jun 24th 2021

royUK the first one code, works better and correct. Thank you !

pantakos · Jun 24th 2021

Wondering, can the above code only works for newly created tabs and not for Calendar and table? In order to have a steady color

Just wondering...

**royUK** · Jun 24th 2021

You can easily leave the two tabs out of the Loop. I'm not sure what you mean about working only for newly created tans.

pantakos · Jun 24th 2021

My fault. Apologies.

Yes I want to leave out of the loop Calendar & table sheets.

**royUK** · Jun 24th 2021

This should stop it working on those tabs

Code

Private Sub SetTabColor(sheet As Worksheet)
    Dim cell As Range
    Dim bIsEmpty As Boolean
    
    Select Case sheet.Name
        Case "Calendar", "table"
            ''///ignore
        Case Else
            For Each cell In Union(sheet.Range("B3:E5"), sheet.Range("B10:E12")).Cells
                If IsEmpty(cell) = True Then
                    bIsEmpty = True
                    Exit For
                End If
            Next cell
            
            
            If bIsEmpty = True Then
                sheet.Tab.Color = vbYellow
            Else
                sheet.Tab.Color = vbRed
                MsgBox "You can now save the file"
            End If
    End Select
End Sub

Display More

pantakos · Jun 24th 2021

Now ok ignore Calendar and table but also ignore all other tabs

pantakos · Jun 24th 2021

Oh.. the code is actually working but only If I close and open file, not on the fly as the previous one. So ignore works.

**royUK** · Jun 24th 2021

You've set the WorkBook Open event to call the code. When do you want it to run?

pantakos · Jun 24th 2021

I did something stupid! I copied a part of code, so not working

I copied all code and everything is working perfect !!!

I am ok, thank you very very much for your effort and patience!

Thanks!

**royUK** · Jun 24th 2021

Pleased to help.

pantakos · Jun 24th 2021

if I ask (if it can be) one very very last help, is it possible?

Is it possible when tab goes red also the date of the calendar be red and stay red and the next day? Something like, "ok that day is complete"

If not possible, its ok I understand, anyway your help is more than expected!

Thank you

Calendar Dynamic Color Cell - VBA

Participate now!

Share