excel vba color tab

kelvin_9 · Mar 30, 2022

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

A

B

C

D

E

F

G

H

I

J

1

Order SN

READY TO PICK

2

Order Date

3

Type

4

Number

5

Pick Up

6

Remarks

7

Picker Name

8

9

#

UPC

UPC Product

Name

Quantity

Unit Price

Subtotal

Qty picked

Pending pickup qty

Remark

10

1

400050873737

11

2

400051339171

12

13

Total

14

Discount

15

Total Amount

16

220306004957866560

thank you very much

cooper645 · Apr 16, 2022

kelvin_9 said:
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

No point reinventing the wheel ….. here you go Sort by tab color

kelvin_9 · Apr 16, 2022

cooper645 said:
No point reinventing the wheel ….. here you go Sort by tab color

Hi cooper645
thank you very much for you reply

this is great and i've tried just now but the result a little bit different with my expectation
all "no color tab" was arranged at the end but i want it at the first
i'm not quite understand what should i amend this code to achieve my goal

beside, do you think i can add this exclusion in too?

VBA Code:

If ws.CodeName <> "Sheet1" And ws.CodeName <> "Sheet2" Then

thank you very much

cooper645 · Apr 16, 2022

I would add the line at the end to move the position of Sheet 1 and 2 back to the start. I’ll have a look later as I’m currently enjoying the sun with a bbq and some beers

kelvin_9 · Apr 16, 2022

cooper645 said:
I would add the line at the end to move the position of Sheet 1 and 2 back to the start. I’ll have a look later as I’m currently enjoying the sun with a bbq and some beers

Hi cooper645
thank you very much for you reply

let's say CHEERS...... ?

will wait for you sure

thank you very much

cooper645 · Apr 18, 2022

How does the following code work for you?

VBA Code:

Option Explicit

Sub ColorTabsAndSortColour()

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
Dim CSI As Long, PSI As Long

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 ' A color tab blue
If colG = True Then Sheets(i).Tab.ColorIndex = 6 ' A color tab yellow
If colA = True And colD = True Then Sheets(i).Tab.ColorIndex = 6 'A and D, red and blue = purple
If colA = True And colG = True Then Sheets(i).Tab.ColorIndex = 6  'A and G, red and yellow = orange
If colD = True And colG = True Then Sheets(i).Tab.ColorIndex = 6  'D and G, blue and yellow = green
If colA = True And colD = True And colG = True Then Sheets(i).Tab.ColorIndex = 6 'All 3 columns, blue, yellow and red = black
   
Next i


'SORT BY COLOR

For CSI = 1 To Sheets.Count
    For PSI = 1 To Sheets.Count - 1
        If Sheets(PSI).Tab.ColorIndex = Sheets(CSI).Tab.ColorIndex Then
            Sheets(PSI).Move before:=Sheets(CSI)
        End If
    Next PSI
Next CSI

Application.ScreenUpdating = True

End Sub

kelvin_9 · Apr 19, 2022

cooper645 said:

How does the following code work for you?

VBA Code:

Option Explicit

Sub ColorTabsAndSortColour()

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
Dim CSI As Long, PSI As Long

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 ' A color tab blue
If colG = True Then Sheets(i).Tab.ColorIndex = 6 ' A color tab yellow
If colA = True And colD = True Then Sheets(i).Tab.ColorIndex = 6 'A and D, red and blue = purple
If colA = True And colG = True Then Sheets(i).Tab.ColorIndex = 6  'A and G, red and yellow = orange
If colD = True And colG = True Then Sheets(i).Tab.ColorIndex = 6  'D and G, blue and yellow = green
If colA = True And colD = True And colG = True Then Sheets(i).Tab.ColorIndex = 6 'All 3 columns, blue, yellow and red = black
  
Next i


'SORT BY COLOR

For CSI = 1 To Sheets.Count
    For PSI = 1 To Sheets.Count - 1
        If Sheets(PSI).Tab.ColorIndex = Sheets(CSI).Tab.ColorIndex Then
            Sheets(PSI).Move before:=Sheets(CSI)
        End If
    Next PSI
Next CSI

Application.ScreenUpdating = True

End Sub

Hi cooper645
thank you very much for your reply

i have tried twice and it goes all yellow except sheet1?
result.jpg

cooper645 · Apr 19, 2022

Thats my oversight i believe, i changed some of the original code for testing, apologies.

I have amended it below, but the result is still varied:

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
Dim CSI As Long, PSI As Long

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 ' A color tab blue
If colG = True Then Sheets(i).Tab.ColorIndex = 6 ' A 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


'SORT BY COLOR

For CSI = 1 To Sheets.Count
    For PSI = 1 To Sheets.Count - 1
        If Sheets(PSI).Tab.ColorIndex = Sheets(CSI).Tab.ColorIndex Then
            Sheets(PSI).Move before:=Sheets(CSI)
        End If
    Next PSI
Next CSI

Application.ScreenUpdating = True

End Sub

kelvin_9 · Apr 19, 2022

cooper645 said:

Thats my oversight i believe, i changed some of the original code for testing, apologies.

I have amended it below, but the result is still varied:

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
Dim CSI As Long, PSI As Long

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 ' A color tab blue
If colG = True Then Sheets(i).Tab.ColorIndex = 6 ' A 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


'SORT BY COLOR

For CSI = 1 To Sheets.Count
    For PSI = 1 To Sheets.Count - 1
        If Sheets(PSI).Tab.ColorIndex = Sheets(CSI).Tab.ColorIndex Then
            Sheets(PSI).Move before:=Sheets(CSI)
        End If
    Next PSI
Next CSI

Application.ScreenUpdating = True

End Sub

Hi cooper645
thank you very much for your reply

no fault at all on you, please, please dont oversight
i have tried just now, same result as #16 the picture i post ?‍

excel vba color tab

kelvin_9

Active Member

cooper645

Well-known Member

Excel Facts

kelvin_9

Active Member

cooper645

Well-known Member

kelvin_9

Active Member

cooper645

Well-known Member

kelvin_9

Active Member

cooper645

Well-known Member

kelvin_9

Active Member

Similar threads

Forum statistics

Share this page

excel vba color tab

Active Member

Well-known Member

Excel Facts

Active Member

Well-known Member

Active Member

Well-known Member

Active Member

Well-known Member

Active Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock