excel vba color tab

K

kelvin_9

Active Member
Joined
Mar 6, 2015
Messages
460
Office Version
  1. 2019
Hello All,

column A, D & G at sheet 1 is the UPC prodcut storage
sheet 2 onwards is the order details, column C is the UPC product
sheet2 of my workbook as example as below

I need a vba to search for the same UPC product as column A or column D or column G of sheet1 in the worksheet C column of the entire workbook, if found the same UPC product, i'd like to tab color as red, yellow and blue respectively
example. if 400050873737 was found in column A or D or G of sheet 1, color tab as request

bbb pick.xlsx
ABCDEFGHIJ
1Order SNREADY TO PICK
2Order Date
3Type
4Number
5Pick Up
6Remarks
7Picker Name
8
9#UPCUPC ProductNameQuantityUnit PriceSubtotalQty pickedPending pickup qtyRemark
101400050873737400050873737
112400051339171400051339171
12
13Total
14Discount
15Total Amount
16
220306004957866560


thank you very much
 

Excel Facts

How to show all formulas in Excel?
Press Ctrl+` to show all formulas. Press it again to toggle back to numbers. The grave accent is often under the tilde on US keyboards.
Sort by date Sort by votes
How does the following work for you??

Test on a copy of your workbook just incase !!

VBA Code: 
Option Explicit

Sub ColorTabs()

On Error Resume Next

Application.ScreenUpdating = False

Dim ws As Worksheet, i As Integer, ShCnt As Integer, j As Integer, LRow As Long
Dim Sh1A As Range, Sh1D As Range, Sh1G As Range, cell As Range

ShCnt = ThisWorkbook.Worksheets.Count

Set Sh1A = Sheets(1).Range("A1:A" & Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row)
Set Sh1D = Sheets(1).Range("D1:D" & Sheets(1).Cells(Rows.Count, "D").End(xlUp).Row)
Set Sh1G = Sheets(1).Range("G1:G" & Sheets(1).Cells(Rows.Count, "G").End(xlUp).Row)

For i = 2 To ShCnt
    LRow = Sheets(i).Range("C10").CurrentRegion.Rows.Count
    For j = 10 To LRow + 10
        For Each cell In Sh1A
            If cell.Value = Sheets(i).Cells(j, 3).Value Then Sheets(i).Tab.ColorIndex = 3 'color tab red
        Next cell
    Next j
Next i

For i = 2 To ShCnt
    LRow = Sheets(i).Range("C10").CurrentRegion.Rows.Count
    For j = 10 To LRow + 10
        For Each cell In Sh1D
            If cell.Value = Sheets(i).Cells(j, 3).Value Then Sheets(i).Tab.ColorIndex = 5 'color tab blue
        Next cell
    Next j
Next i


For i = 2 To ShCnt
    LRow = Sheets(i).Range("C10").CurrentRegion.Rows.Count
    For j = 10 To LRow + 10
        For Each cell In Sh1G
            If cell.Value = Sheets(i).Cells(j, 3).Value Then Sheets(i).Tab.ColorIndex = 6 'color tab yellow
        Next cell
    Next j
Next i

Application.ScreenUpdating = True

End Sub
 
Upvote 0
cooper645 said:
How does the following work for you??

Test on a copy of your workbook just incase !!

VBA Code: 
Option Explicit

Sub ColorTabs()

On Error Resume Next

Application.ScreenUpdating = False

Dim ws As Worksheet, i As Integer, ShCnt As Integer, j As Integer, LRow As Long
Dim Sh1A As Range, Sh1D As Range, Sh1G As Range, cell As Range

ShCnt = ThisWorkbook.Worksheets.Count

Set Sh1A = Sheets(1).Range("A1:A" & Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row)
Set Sh1D = Sheets(1).Range("D1:D" & Sheets(1).Cells(Rows.Count, "D").End(xlUp).Row)
Set Sh1G = Sheets(1).Range("G1:G" & Sheets(1).Cells(Rows.Count, "G").End(xlUp).Row)

For i = 2 To ShCnt
    LRow = Sheets(i).Range("C10").CurrentRegion.Rows.Count
    For j = 10 To LRow + 10
        For Each cell In Sh1A
            If cell.Value = Sheets(i).Cells(j, 3).Value Then Sheets(i).Tab.ColorIndex = 3 'color tab red
        Next cell
    Next j
Next i

For i = 2 To ShCnt
    LRow = Sheets(i).Range("C10").CurrentRegion.Rows.Count
    For j = 10 To LRow + 10
        For Each cell In Sh1D
            If cell.Value = Sheets(i).Cells(j, 3).Value Then Sheets(i).Tab.ColorIndex = 5 'color tab blue
        Next cell
    Next j
Next i


For i = 2 To ShCnt
    LRow = Sheets(i).Range("C10").CurrentRegion.Rows.Count
    For j = 10 To LRow + 10
        For Each cell In Sh1G
            If cell.Value = Sheets(i).Cells(j, 3).Value Then Sheets(i).Tab.ColorIndex = 6 'color tab yellow
        Next cell
    Next j
Next i

Application.ScreenUpdating = True

End Sub
Click to expand...
cooper465
thank you very much for your reply

at least I haven't seen any mismatches so far unless more than 1 UPC product is found, the color then return based on the last row of column C
example: 2 UPC product in column C which same as either 2 column of A or D or G, the color will return the last UPC product color

will keep on try in this week
 
Upvote 0
Do you need it only to check the first row of column C?
 
Upvote 0
cooper645 said:
Do you need it only to check the first row of column C?
Click to expand...
cooper645
thank you for your reply

i dont need to check/return the first UPC product
i'm still struggle on one more rule that color green if more than 1 UPC product found in column C as easy reference, but it seems messy while too many color
 
Upvote 0
kelvin_9 said:
cooper645
thank you for your reply

i'm not only check/return the first UPC product, i should have it all
however one more rule (example, color green) if more than 1 UPC product found in column C as easy reference, it seems messy while too many color
Click to expand...
 
Upvote 0
cooper645 said:
Do you need it only to check the first row of column C?
Click to expand...
Hi cooper645
with your code, the final tab color is based on the last row in column C
what should i do if i would like to use color index = 4 as special care

example:
400051346254 in column C found in column A at sheet 1, with your code colorIndex = 3, tab is red
400051357267 in column C found in column D at sheet 1, with your code colorIndex = 5, tab is blue

test case.xlsx
ABCDEFGHIJ
1Order SNREADY TO PICK
2Order Date
3Type
4Number
5Pick Up
6Remarks
7Picker Name
8
9#UPCUPC ProductNameQuantityUnit PriceSubtotalQty pickedPending pickup qtyRemark
101400051346254400051346254
112400051357267400051357267
123400051163141400051163141
13
14Total
15Discount
16Total Amount
220306002704930260
 
Upvote 0
Here you go, I have amended the code with some booleans, which then checks all columns, and changes the booleans appropriately, then checks the boolean conditions and colours the tab in a logical of order of true outcomes.

You can amend the code to suit but I have used a colour wheel outcome to determine the mixed colours, you can of course change all multiple true booleans to be a single tab colour of your choice. ie: change the tab colours (7, 45, 4, 1) to all be a single colour

VBA Code: 
Option Explicit

Sub ColorTabs()

On Error Resume Next

Application.ScreenUpdating = False

Dim ws As Worksheet, i As Integer, ShCnt As Integer, j As Integer, LRow As Long
Dim Sh1A As Range, Sh1D As Range, Sh1G As Range, cell As Range
Dim colA As Boolean, colD As Boolean, colG As Boolean

ShCnt = ThisWorkbook.Worksheets.Count

Set Sh1A = Sheets(1).Range("A1:A" & Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row)
Set Sh1D = Sheets(1).Range("D1:D" & Sheets(1).Cells(Rows.Count, "D").End(xlUp).Row)
Set Sh1G = Sheets(1).Range("G1:G" & Sheets(1).Cells(Rows.Count, "G").End(xlUp).Row)

For i = 2 To ShCnt

colA = False
colD = False
colG = False

    LRow = Sheets(i).Range("C10").CurrentRegion.Rows.Count
    For j = 10 To LRow + 10
   
        For Each cell In Sh1A
            If cell.Value = Sheets(i).Cells(j, 3).Value Then colA = True 'Sheets(i).Tab.ColorIndex = 3  'color tab red
        Next cell
       
        For Each cell In Sh1D
            If cell.Value = Sheets(i).Cells(j, 3).Value Then colD = True 'Sheets(i).Tab.ColorIndex = 5 'color tab blue
        Next cell
       
        For Each cell In Sh1G
            If cell.Value = Sheets(i).Cells(j, 3).Value Then colG = True 'Sheets(i).Tab.ColorIndex = 6 'color tab yellow
        Next cell
       
    Next j

If colA = True Then Sheets(i).Tab.ColorIndex = 3 ' A color tab red
If colD = True Then Sheets(i).Tab.ColorIndex = 5 ' D color tab blue
If colG = True Then Sheets(i).Tab.ColorIndex = 6 ' G color tab yellow
If colA = True And colD = True Then Sheets(i).Tab.ColorIndex = 7 'A and D, red and blue = purple
If colA = True And colG = True Then Sheets(i).Tab.ColorIndex = 45  'A and G, red and yellow = orange
If colD = True And colG = True Then Sheets(i).Tab.ColorIndex = 4  'D and G, blue and yellow = green
If colA = True And colD = True And colG = True Then Sheets(i).Tab.ColorIndex = 1 'All 3 columns, blue, yellow and red = black
   
Next i

Application.ScreenUpdating = True

End Sub
 
Upvote 0
cooper645 said:
Here you go, I have amended the code with some booleans, which then checks all columns, and changes the booleans appropriately, then checks the boolean conditions and colours the tab in a logical of order of true outcomes.

You can amend the code to suit but I have used a colour wheel outcome to determine the mixed colours, you can of course change all multiple true booleans to be a single tab colour of your choice. ie: change the tab colours (7, 45, 4, 1) to all be a single colour

VBA Code: 
Option Explicit

Sub ColorTabs()

On Error Resume Next

Application.ScreenUpdating = False

Dim ws As Worksheet, i As Integer, ShCnt As Integer, j As Integer, LRow As Long
Dim Sh1A As Range, Sh1D As Range, Sh1G As Range, cell As Range
Dim colA As Boolean, colD As Boolean, colG As Boolean

ShCnt = ThisWorkbook.Worksheets.Count

Set Sh1A = Sheets(1).Range("A1:A" & Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row)
Set Sh1D = Sheets(1).Range("D1:D" & Sheets(1).Cells(Rows.Count, "D").End(xlUp).Row)
Set Sh1G = Sheets(1).Range("G1:G" & Sheets(1).Cells(Rows.Count, "G").End(xlUp).Row)

For i = 2 To ShCnt

colA = False
colD = False
colG = False

    LRow = Sheets(i).Range("C10").CurrentRegion.Rows.Count
    For j = 10 To LRow + 10
  
        For Each cell In Sh1A
            If cell.Value = Sheets(i).Cells(j, 3).Value Then colA = True 'Sheets(i).Tab.ColorIndex = 3  'color tab red
        Next cell
      
        For Each cell In Sh1D
            If cell.Value = Sheets(i).Cells(j, 3).Value Then colD = True 'Sheets(i).Tab.ColorIndex = 5 'color tab blue
        Next cell
      
        For Each cell In Sh1G
            If cell.Value = Sheets(i).Cells(j, 3).Value Then colG = True 'Sheets(i).Tab.ColorIndex = 6 'color tab yellow
        Next cell
      
    Next j

If colA = True Then Sheets(i).Tab.ColorIndex = 3 ' A color tab red
If colD = True Then Sheets(i).Tab.ColorIndex = 5 ' D color tab blue
If colG = True Then Sheets(i).Tab.ColorIndex = 6 ' G color tab yellow
If colA = True And colD = True Then Sheets(i).Tab.ColorIndex = 7 'A and D, red and blue = purple
If colA = True And colG = True Then Sheets(i).Tab.ColorIndex = 45  'A and G, red and yellow = orange
If colD = True And colG = True Then Sheets(i).Tab.ColorIndex = 4  'D and G, blue and yellow = green
If colA = True And colD = True And colG = True Then Sheets(i).Tab.ColorIndex = 1 'All 3 columns, blue, yellow and red = black
  
Next i

Application.ScreenUpdating = True

End Sub
Click to expand...
Hi cooper645
thank you very much for your reply

jesus, i love this and this is real impeccable
will keep on try in this week

thank you very much again
 
Upvote 0
cooper645 said:
Here you go, I have amended the code with some booleans, which then checks all columns, and changes the booleans appropriately, then checks the boolean conditions and colours the tab in a logical of order of true outcomes.

You can amend the code to suit but I have used a colour wheel outcome to determine the mixed colours, you can of course change all multiple true booleans to be a single tab colour of your choice. ie: change the tab colours (7, 45, 4, 1) to all be a single colour

VBA Code: 
Option Explicit

Sub ColorTabs()

On Error Resume Next

Application.ScreenUpdating = False

Dim ws As Worksheet, i As Integer, ShCnt As Integer, j As Integer, LRow As Long
Dim Sh1A As Range, Sh1D As Range, Sh1G As Range, cell As Range
Dim colA As Boolean, colD As Boolean, colG As Boolean

ShCnt = ThisWorkbook.Worksheets.Count

Set Sh1A = Sheets(1).Range("A1:A" & Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row)
Set Sh1D = Sheets(1).Range("D1:D" & Sheets(1).Cells(Rows.Count, "D").End(xlUp).Row)
Set Sh1G = Sheets(1).Range("G1:G" & Sheets(1).Cells(Rows.Count, "G").End(xlUp).Row)

For i = 2 To ShCnt

colA = False
colD = False
colG = False

    LRow = Sheets(i).Range("C10").CurrentRegion.Rows.Count
    For j = 10 To LRow + 10
  
        For Each cell In Sh1A
            If cell.Value = Sheets(i).Cells(j, 3).Value Then colA = True 'Sheets(i).Tab.ColorIndex = 3  'color tab red
        Next cell
      
        For Each cell In Sh1D
            If cell.Value = Sheets(i).Cells(j, 3).Value Then colD = True 'Sheets(i).Tab.ColorIndex = 5 'color tab blue
        Next cell
      
        For Each cell In Sh1G
            If cell.Value = Sheets(i).Cells(j, 3).Value Then colG = True 'Sheets(i).Tab.ColorIndex = 6 'color tab yellow
        Next cell
      
    Next j

If colA = True Then Sheets(i).Tab.ColorIndex = 3 ' A color tab red
If colD = True Then Sheets(i).Tab.ColorIndex = 5 ' D color tab blue
If colG = True Then Sheets(i).Tab.ColorIndex = 6 ' G color tab yellow
If colA = True And colD = True Then Sheets(i).Tab.ColorIndex = 7 'A and D, red and blue = purple
If colA = True And colG = True Then Sheets(i).Tab.ColorIndex = 45  'A and G, red and yellow = orange
If colD = True And colG = True Then Sheets(i).Tab.ColorIndex = 4  'D and G, blue and yellow = green
If colA = True And colD = True And colG = True Then Sheets(i).Tab.ColorIndex = 1 'All 3 columns, blue, yellow and red = black
  
Next i

Application.ScreenUpdating = True

End Sub
Click to expand...
Hi cooper645

just curious if this code can add in a sorting function on tab color? likely tab color index xlAutomatic first, then 3, 5, 6.....

thank you very much
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question Question
Help with scanning barcodes into an excel invoice
2
Replies
12
Views
1K
RoryA
RoryA
itsrich
  • Solved
Indirect Syntax - Outside the workbook
Replies
7
Views
244
itsrich
itsrich
C
  • Solved
Macro/VBA for lookups
Replies
9
Views
183
mumps
mumps
Y
  • Question Question
VBA Code to activate the tab and and transfer data
Replies
1
Views
261
Joe4
Joe4
B
  • Question Question
Excel VBA Searching Unique Variables to Match against Exported Schedule Files to Determine Date
Replies
1
Views
189
sijpie
sijpie

Forum statistics

Threads
1,224,828
Messages
6,181,209
Members
453,023
Latest member
alabaz

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top