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
 
Sort by date Sort by votes

Excel Facts

What is the last column in Excel?
Excel columns run from A to Z, AA to AZ, AAA to XFD. The last column is XFD.
cooper645 said:
No point reinventing the wheel ….. here you go Sort by tab color
Click to expand...
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
 
Upvote 0
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
 
Upvote 0
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
Click to expand...
Hi cooper645
thank you very much for you reply

let's say CHEERS...... ?:p
will wait for you sure

thank you very much
 
Upvote 0
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
 
Upvote 0
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
Click to expand...
Hi cooper645
thank you very much for your reply

i have tried twice and it goes all yellow except sheet1?
result.jpg
 
Upvote 0
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
 
Upvote 0
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
Click to expand...
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 ?‍♂️
 
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
209
itsrich
itsrich
Y
  • Question Question
VBA Code to activate the tab and and transfer data
Replies
1
Views
240
Joe4
Joe4
B
  • Question Question
Excel VBA Searching Unique Variables to Match against Exported Schedule Files to Determine Date
Replies
1
Views
158
sijpie
sijpie
S
  • Question Question
VBA Code that extracts multiple tabs at a time based on lookup tab
2
Replies
10
Views
474
NoSparks
N

Forum statistics

Threads
1,223,919
Messages
6,175,368
Members
452,638
Latest member
Oluwabukunmi

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