Tab Name & Color Change Based on Value

[r0bism123]

Morning gang!

I finally got the code below to work with a color change, but I am struggling to get it to change the corresponding tab name. My goal with the code is to have cells A16 to A83 on my rent schedule tab, change the corresponding tab name and color with the content therein.

For example, if I enter the name "Tenant 1" I want the tab name to change to "Tenant 1" and turn yellow. However, if I enter the word "Vacant", I want the tab to change to "Vacant" and turn red only for Vacant suites.

Any help getting this to work for me would be huge! Thank you in advance for your time!

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A:A")) Is Nothing Then
On Error GoTo M
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
If Target.Row > 15 Then
If Target.Value = "Vacant" Or Target.Value = "vacant" Then
Sheets(Target.Row + 1).Tab.Color = RGB(255, 76, 76)
Else
Sheets(Target.Row + 1).Tab.Color = RGB(255, 248, 66)
End If
End If
End If
Exit Sub
M:
MsgBox "That sheet number  " & (Target.Row - 0) & "  does not exist"
End Sub

 

[mse330]

You can achieve that by the below added 2 lines … Note that I have added the sheet # as you can not have multiple tabs (sheets) with the same name such as "Vacant"

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A:A")) Is Nothing Then
On Error GoTo M
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
    If Target.Row > 15 Then
            If Target.Value = "Vacant" Or Target.Value = "vacant" Then
                Sheets(Target.Row + 1).Tab.Color = RGB(255, 76, 76)
                Sheets(Target.Row + 1).Name = "Vacant " & Target.Row + 1
            Else
                Sheets(Target.Row + 1).Tab.Color = RGB(255, 248, 66)
                Sheets(Target.Row + 1).Name = "Tenant " & Target.Row + 1
            End If
        End If
    End If
Exit Sub
M:
MsgBox "That sheet number  " & (Target.Row - 0) & "  does not exist"
End Sub

 

[r0bism123]

Thanks for your help, mse330. This worked about 50% of way I intended. The name changes, however, it does not display the content I have in cell A16:A83.

For example, I have "ABC, Corp." as the tenant in unit 100, but the tab says "Tenant 0". I want it to say "ABC, Corp.".

On the vacant units, I want the tab to change to the RGB color, and then utilize the following code:

Sub NameWS()
    On Error Resume Next
        For Each ws In ThisWorkbook.Worksheets
    ws.Name = Left(ws.Cells(5, 3).Value, 31)
        Next
    On Error GoTo 0
End Sub

On the individual sheets, the cell called out in "ws.Cells(5, 3).Value, 31" are setup to display "Vacant-100" or "Vacant-200" etc. so the tabs will not conflict with one another.

Any help is greatly appreciated!

 

[My Aswer Is This]

Try this:
The sheet is named with the Target.value
If vacant is entered sheet is named with value in Cells(5,3)

Private Sub Worksheet_Change(ByVal Target As Range)
'Modified 7/9/18 2:25 AM EDT
If Not Intersect(Target, Range("A:A")) Is Nothing Then
Dim ans As Long
On Error GoTo M
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
    If Target.Row > 15 Then
            ans = Target.Row
            If Target.Value = "Vacant" Or Target.Value = "vacant" Then
                Sheets(ans + 1).Tab.Color = RGB(255, 76, 76)
                Sheets(ans + 1).Name = Sheets(ans + 1).Cells(5, 3).Value
            Else
                Sheets(ans + 1).Tab.Color = RGB(255, 248, 66)
                Sheets(ans + 1).Name = Target.Value
             End If
        End If
    End If
   
Exit Sub
M:
MsgBox "That sheet number  " & (Target.Row - 0) & "  does not exist"
End Sub

 

[My Aswer Is This]

Not sure why your doing it this way with a formula in cells(5,3)
That means it looks for first 31 characters in cells(5,3)
Vacant-100 does not have 31 characters.

But I guess you have your reasons.

I would think you could use Vacant and the sheet name

Like Vacant Room 20
Or Vacant Room 45

 

[r0bism123]

Hi there,

Thank you for your time in this. This edit works perfectly! I really appreciate it!

My idea on the 31 characters was to limit the amount of content in various other reports, so that when they are printed, the reports are uniform and same sizes. I messed with this a few times and this was the only way I could figure this out. I am still a noob...

Thanks again for your help.

 

[My Aswer Is This]

Glad I was able to help you.
Come back here to Mr. Excel next time you need additional assistance.

Hi there,

Thank you for your time in this. This edit works perfectly! I really appreciate it!

My idea on the 31 characters was to limit the amount of content in various other reports, so that when they are printed, the reports are uniform and same sizes. I messed with this a few times and this was the only way I could figure this out. I am still a noob...

Thanks again for your help.

 

[r0bism123]

Hi there,

I am hoping you can help me with one other item. I ran into an issue. When I protect the workbook structure, the code below will not work as it prompts me with my error message. Is there a way to unprotect the workbook structure, then the sheet, the rename to tab to the cell in the code below, then password protect the sheet and workbook structure once again? I hope that makes sense.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A:A")) Is Nothing Then
Dim ans As Long
On Error GoTo M
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
    If Target.Row > 15 Then
            ans = Target.Row
            If Target.Value = "Vacant" Or Target.Value = "vacant" Then
                Sheets(ans + 1).Tab.Color = RGB(255, 76, 76)
                Sheets(ans + 1).Name = Sheets(ans + 1).Cells(5, 3).Value
            Else
                Sheets(ans + 1).Tab.Color = RGB(255, 248, 66)
                Sheets(ans + 1).Name = Target.Value
             End If
        End If
    End If
   
Exit Sub
M:
MsgBox "Error: Duplicate Tenant Name"
End Sub

Thanks!

 

[My Aswer Is This]

I'm not familiar with writing code to automatically unprotect and then protect workbook sheets.
I suggest you seek help in a new posting on this forum.

And I would have lots of questions.
Like protect and unprotect what sheets.

 

[mse330]

Hi there,

I am hoping you can help me with one other item. I ran into an issue. When I protect the workbook structure, the code below will not work as it prompts me with my error message. Is there a way to unprotect the workbook structure, then the sheet, the rename to tab to the cell in the code below, then password protect the sheet and workbook structure once again? I hope that makes sense.

To protect & unprotect the workbook & sheet you can use the below

' To unprotect before your code
ActiveWorkbook.Unprotect Password:="xyz"
Sheets(1).Unprotect Password:="xyz"
​
'Protect back again
ActiveWorkbook.Protect Password:="xyz"
Sheets(1).Protect Password:="xyz"