Change tab colour if text in column N

[raphagcwill]

Hi there,

wondering if you could help me to make the below.

I have a workbook with more then 20 sheets. My goal is to make each tabs change colour if a specific text is found on column N

I have managed to write the below code, but it takes 10 seconds for it to complete the task. It is worth saying that I am not very familiar with VBA and that the below was the result of me combining solutions i found on the internet loops - Excel VBA; If a value in column M equals x then column A should Equal Column E - Stack Overflow

Can somebody help me to make it faster? Should I insert a lastrow on my code?

Thanks in advance


Sub CHANGE_TAB_COLOUR()




Dim SOURCEWS As Worksheet
Set SOURCEWS = ActiveSheet


Dim lngLoop As Long
Dim LastRow As Long


lngLoop = 1


For lngLoop = 1 To Rows.Count


If Cells(lngLoop, 14).Value = "SETTLE" Then
With SOURCEWS.Tab
.Color = 5296274
.TintAndShade = 0
End With
ElseIf Cells(lngLoop, 14).Value = "PPO" Then
With SOURCEWS.Tab
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
End With
ElseIf Cells(lngLoop, 14) = "PO" Then
With SOURCEWS.Tab
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
End With


End If
Next




End Sub

 

[shg]

Untested:

Sub CHANGE_TAB_COLOUR()
  Dim wks           As Worksheet
  Dim vs            As Variant
  Dim rFind         As Range

  Set wks = ActiveSheet

  With wks
    For Each vs In Array("SETTLE", "PPO", "PO")
      Set rFind = .Range("N:N").Find(What:=vs, LookAt:=xlWhole, MatchCase:=True)
      If Not rFind Is Nothing Then
        If vs = "SETTLE" Then
          .Tab.Color = 5296274
          .Tab.TintAndShade = 0
        Else
          .Tab.ThemeColor = xlThemeColorDark1
          .Tab.TintAndShade = -0.15
        End If
        Exit Sub
      End If
    Next vs
  End With
End Sub

 

[raphagcwill]

Thanks for you prompt reply, shg.

It is way faster and no error has been found. Bt there is one problem.

the tab colour changes always to green, even when "po" and "ppo" are found.

If column contains only "Settle" then the tab should turn to gree, otherwise remain unchangedm whh is the same as ( .Tab.ThemeColor = xlThemeColorDark1Tab.TintAndShade = -0.15)

Thans in advance

 

[shg]

Then reverse the find order:

For Each vs In Array("PO, "PPO", "SETTLE")

 

[raphagcwill]

Bingo, works like a charm

Tanks a million for that.

Mucha gracias

 

[shg]

You're welcome.

 

[raphagcwill]

Hello again,

Could you please help to make this makro loop thru all wotksheets?
As of now i have to manually run it on all the 20 + sheets my wotkbook has.
Tried copying in to the makro that creates the sheets, but nothing happens.

Once again, thanks for the help

Sub CHANGE_TAB_COLOUR()
Dim wks As Worksheet
Dim vs As Variant
Dim rFind As Range

Set wks = ActiveSheet

With wks
For Each vs In Array("PO", "PPO", "SETTLE")
Set rFind = .Range("N:N").Find(What:=vs, LookAt:=xlWhole, MatchCase:=True)
If Not rFind Is Nothing Then
If vs = "SETTLE" Then
.Tab.Color = 5296274
.Tab.TintAndShade = 0
Else
.Tab.ThemeColor = xlThemeColorDark1
.Tab.TintAndShade = -0.15
End If
Exit Sub
End If
Next vs
End With
End Sub