excel vba change cell color based on tabs color

K

kelvin_9

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

assuming i have 20 data in range A2:A21 at sheet 1 and they are same as the tabs name
i need a vba to return same color index (3, 5 and 6) in column A if tabs color was changed

example: when tabs name(220408120732319399) was changed to colorindex 5, i want cell A9(220408120732319399) change to colorindex 5 as well

thank you very much
 
Sort by date Sort by votes

Excel Facts

What do {} around a formula in the formula bar mean?
{Formula} means the formula was entered using Ctrl+Shift+Enter signifying an old-style array formula.
Try:
VBA Code: 
Sub ColorCells()
    Application.ScreenUpdating = False
    Dim v As Variant, desWS As Worksheet, i As Long, lRow As Long
    Set desWS = Sheets("SUMMARY")
    With desWS
        lRow = .Range("A" & .Rows.count).End(xlUp).Row
        v = .Range("A2:A" & lRow).Value
        For i = LBound(v) To UBound(v)
            If Evaluate("isref('" & CStr(v(i, 1)) & "'!A1)") Then
                If Sheets(CStr(v(i, 1))).Tab.Color <> 0 Then
                    .Range("A" & i + 1).Interior.Color = Sheets(CStr(v(i, 1))).Tab.Color
                End If
            Else
                .Range("A" & i + 1).Interior.Color = vbBlack
            End If
        Next i
    End With
    With desWS.Sort
        .SortFields.Clear
        .SortFields.Add(Range("A2:A" & lRow), xlSortOnCellColor, xlDescending, , xlSortNormal).SortOnValue.Color = RGB(0, 0, 0)
        .SetRange Range("A1:A" & lRow)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
mumps said:
Try:
VBA Code: 
Sub ColorCells()
    Application.ScreenUpdating = False
    Dim v As Variant, desWS As Worksheet, i As Long, lRow As Long
    Set desWS = Sheets("SUMMARY")
    With desWS
        lRow = .Range("A" & .Rows.count).End(xlUp).Row
        v = .Range("A2:A" & lRow).Value
        For i = LBound(v) To UBound(v)
            If Evaluate("isref('" & CStr(v(i, 1)) & "'!A1)") Then
                If Sheets(CStr(v(i, 1))).Tab.Color <> 0 Then
                    .Range("A" & i + 1).Interior.Color = Sheets(CStr(v(i, 1))).Tab.Color
                End If
            Else
                .Range("A" & i + 1).Interior.Color = vbBlack
            End If
        Next i
    End With
    With desWS.Sort
        .SortFields.Clear
        .SortFields.Add(Range("A2:A" & lRow), xlSortOnCellColor, xlDescending, , xlSortNormal).SortOnValue.Color = RGB(0, 0, 0)
        .SetRange Range("A1:A" & lRow)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Application.ScreenUpdating = True
End Sub
Click to expand...
Hi mumps
thank you for your reply

anything i did wrong? seems not function well, only the cell color black go to the end:oops:
111.jpg

thank you very much
 
Upvote 0
last when cell color index = black
Click to expand...
That is what you requested. This is what I get when I run the macro:
kelvin.xlsm
A
1Order ID#
2220408082500623556
3220408110338272581
4220408120732319399
5220408120732997586
6220408014059601495
7220408094403852836
8220408104323972983
9220408110203623574
10220408110255197474
11220408110314288956
12220408110333240110
13220408110344507460
14220408110355347470
SUMMARY
 
Upvote 0
mumps said:
That is what you requested. This is what I get when I run the macro:
kelvin.xlsm
A
1Order ID#
2220408082500623556
3220408110338272581
4220408120732319399
5220408120732997586
6220408014059601495
7220408094403852836
8220408104323972983
9220408110203623574
10220408110255197474
11220408110314288956
12220408110333240110
13220408110344507460
14220408110355347470
SUMMARY
Click to expand...
Hi mumps
thank you very much for your reply

:eek:
this is weird
understood that all is what i want
any cue why you can sort all color in what i want but i can't do it except black color go to the end?

i just try again in a new workbook, but all go black o_O


thank you very much
 
Upvote 0
Can you upload a copy of your file to a free site such as www.box.com or www.dropbox.com? Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here.(de-sensitized if necessary).
 
Upvote 0
Try:
VBA Code: 
Sub ColorCells()
    Application.ScreenUpdating = False
    Dim v As Variant, desWS As Worksheet, i As Long, lRow As Long
    Set desWS = Sheets("SUMMARY")
    With desWS
        lRow = .Range("A" & .Rows.count).End(xlUp).Row
        v = .Range("A2:A" & lRow).Value
        For i = LBound(v) To UBound(v)
            If Evaluate("isref('" & CStr(v(i, 1)) & "'!A1)") Then
                If Sheets(CStr(v(i, 1))).Tab.Color <> 0 Then
                    .Range("A" & i + 1).Interior.Color = Sheets(CStr(v(i, 1))).Tab.Color
                End If
            Else
                .Range("A" & i + 1).Interior.Color = vbBlack
            End If
        Next i
    End With
    With desWS.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("A2:A" & lRow), SortOn:=xlSortOnCellColor, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add(Range("A2:A" & lRow), xlSortOnCellColor, xlDescending, , xlSortNormal).SortOnValue.Color = RGB(0, 0, 0)
        .SetRange Range("A1:Y" & lRow)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
mumps said:
Try:
VBA Code: 
Sub ColorCells()
    Application.ScreenUpdating = False
    Dim v As Variant, desWS As Worksheet, i As Long, lRow As Long
    Set desWS = Sheets("SUMMARY")
    With desWS
        lRow = .Range("A" & .Rows.count).End(xlUp).Row
        v = .Range("A2:A" & lRow).Value
        For i = LBound(v) To UBound(v)
            If Evaluate("isref('" & CStr(v(i, 1)) & "'!A1)") Then
                If Sheets(CStr(v(i, 1))).Tab.Color <> 0 Then
                    .Range("A" & i + 1).Interior.Color = Sheets(CStr(v(i, 1))).Tab.Color
                End If
            Else
                .Range("A" & i + 1).Interior.Color = vbBlack
            End If
        Next i
    End With
    With desWS.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("A2:A" & lRow), SortOn:=xlSortOnCellColor, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add(Range("A2:A" & lRow), xlSortOnCellColor, xlDescending, , xlSortNormal).SortOnValue.Color = RGB(0, 0, 0)
        .SetRange Range("A1:Y" & lRow)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Application.ScreenUpdating = True
End Sub
Click to expand...
Hi mumps
thank you very much for your reply

cell with no color & black is prefect, but others is not sorting as request as below

Order ID#
220408121806702374
220408121814839240
220408121836385762
220408121931737641
220408121935236363
220408121941224563
220408120732319399
220408120732997586
220408120742883325
220408120748876347
220408120748233625
220408120757583658
220408120831247369
220408120846858130
220408121233898363
220408121734463603
220408122549172212
220408132726693238
220408132755906161
220408014059601495
220408082500623556
220408094403852836
220408104323972983
220408105352392249
220408110203623574
 
Upvote 0
This is what I get using the file you uploaded:
kelvin.xlsm
ABC
1Order ID#StoreOrder Time
2220408120748876347LIMITED2022-04-08 12:07:48
3220408120831247369LIMITED2022-04-08 12:08:31
4220408120846858130LIMITED2022-04-08 12:08:46
5220408121233898363LIMITED2022-04-08 12:12:33
6220408121734463603LIMITED2022-04-08 12:17:34
7220408121806702374LIMITED2022-04-08 12:18:06
8220408121814839240LIMITED2022-04-08 12:18:14
9220408121836385762LIMITED2022-04-08 12:18:36
10220408121931737641LIMITED2022-04-08 12:19:31
11220408121935236363LIMITED2022-04-08 12:19:35
12220408121941224563LIMITED2022-04-08 12:19:41
13220408122549172212LIMITED2022-04-08 12:25:49
14220408132755906161LIMITED2022-04-08 13:27:55
15220408120732319399LIMITED2022-04-08 12:07:32
16220408120732997586LIMITED2022-04-08 12:07:32
17220408120742883325LIMITED2022-04-08 12:07:42
18220408120748233625LIMITED2022-04-08 12:07:48
19220408120757583658LIMITED2022-04-08 12:07:57
20220408132726693238LIMITED2022-04-08 13:27:26
21220408014059601495NORMAL2022-04-08 01:40:59
22220408082500623556NORMAL2022-04-08 08:25:00
23220408094403852836NORMAL2022-04-08 09:44:03
24220408104323972983NORMAL2022-04-08 10:43:23
25220408105352392249NORMAL2022-04-08 10:53:52
26220408110203623574NORMAL2022-04-08 11:02:03
27220408110255197474LIMITED2022-04-08 11:02:55
28220408110255571326LIMITED2022-04-08 11:02:55
29220408110314288956LIMITED2022-04-08 11:03:14
30220408110324446526LIMITED2022-04-08 11:03:24
31220408110333240110LIMITED2022-04-08 11:03:33
32220408110338272581LIMITED2022-04-08 11:03:38
33220408110344507460LIMITED2022-04-08 11:03:44
34220408110355347470LIMITED2022-04-08 11:03:55
35220408110356525928LIMITED2022-04-08 11:03:56
36220408110403648543LIMITED2022-04-08 11:04:03
37220408110415585878LIMITED2022-04-08 11:04:15
38220408110419433895LIMITED2022-04-08 11:04:19
39220408110421921584LIMITED2022-04-08 11:04:21
40220408110435129990LIMITED2022-04-08 11:04:35
41220408110440149740LIMITED2022-04-08 11:04:40
42220408110443682411LIMITED2022-04-08 11:04:43
43220408110446744362LIMITED2022-04-08 11:04:46
44220408110459919369LIMITED2022-04-08 11:04:59
45220408110501416297LIMITED2022-04-08 11:05:00
46220408110503372426LIMITED2022-04-08 11:05:03
SUMMARY

Are you using the macro in a different workbook?
 
Upvote 0
You must log in or register to reply here.

Similar threads

E
  • Solved
simple tab color change based on any entry of any sheet
2
Replies
17
Views
323
mumps
mumps
D
  • Solved
Excel VBA for Changing Tab Name & Return Blank Cell to Formula
Replies
5
Views
158
DjTRex2002
D
S
  • Solved
Change sheet tab color based on day of the week
Replies
6
Views
708
SubwaySparky
S
Rixn
  • Question
Conditional formatting cell color based on a number range.
Replies
4
Views
384
awoohaw
awoohaw
F
  • Question
No cells were found - trying to copy a hidden row range
Replies
3
Views
86
Micron
M

Forum statistics

Threads
1,215,503
Messages
6,125,175
Members
449,212
Latest member
kenmaldonado

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