Excel 2003, triggering a result from a colour ?

Pauljj

Well-known Member
Joined
Mar 28, 2004
Messages
2,047
An early stage question but if I for example format A1 Green, is it possible that, from a pre-definded list of colours I can say Green = Job A, so the word Job A appears as a text value in for example C1

...and If I formatted A1 Yellow and Yellow meant Job C, that Job C appeared in C1 ?

Many thanks
Paul
 
Obviously (well, perhaps not obviously :-) ) you can adapt my code to deal with lots of colours at the same time...
Code:
Sub Apply_text_based_on_colour()
Dim Cell As Range
Dim Rng1 As Range
Range("G13:G25").Select
Set Rng1 = Selection
For Each Cell In Rng1
Select Case Cell.Interior.ColorIndex
Case 42
Cell.Offset(rowoffset:=0, columnoffset:=10).Value = "BLUE"
Case 43
Cell.Offset(rowoffset:=0, columnoffset:=10).Value = "other colour 1"
Case 87
Cell.Offset(rowoffset:=0, columnoffset:=10).Value = "other colour 2"
End Select
Next
End Sub

Thank you very much Gerald, for taking the time to look at this, its a great help
 
Upvote 0

Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.
Try this:-
If you run out of VbConstants ( see vb Help) you may have to resort to color Numbers.
Code:
[COLOR="Navy"]Sub[/COLOR] MG17May21
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Jobs
Jobs = Array(vbGreen, "Jobs1", vbRed, "Job2", vbYellow, "Job3", vbBlue, "Job4", vbMagenta, "Job5", vbCyan, "Job6")
[COLOR="Navy"]Set[/COLOR] Rng = Range("C7:C50")
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]For[/COLOR] n = 0 To UBound(Jobs) [COLOR="Navy"]Step[/COLOR] 2
        [COLOR="Navy"]If[/COLOR] Dn.Interior.Color = Jobs(n) [COLOR="Navy"]Then[/COLOR]
            Dn.Offset(, 10) = Jobs(n + 1)
             [COLOR="Navy"]Exit[/COLOR] For
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Last edited:
Upvote 0
Mick, I have 13 colours, do you have any idea how I could incorporate your idea with using colour numbers ?
 
Upvote 0
Run this first code in a new sheet, it will give you a range of colours and their index number.
Try using the new code below for Inserting "Job" Titles in column "M".
Add/modify the fixed array in code for you particular job Titles and the related colour index, see:- Code Remarks.

Code:
[COLOR="Navy"]Sub[/COLOR] MG17May33
[COLOR="Navy"]Dim[/COLOR] Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Rw [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
    [COLOR="Navy"]For[/COLOR] Ac = 1 To 8 [COLOR="Navy"]Step[/COLOR] 2
        [COLOR="Navy"]For[/COLOR] Rw = 1 To 12
            c = c + 1
            Cells(Rw, Ac) = c
            Cells(Rw, Ac + 1).Interior.ColorIndex = c
        [COLOR="Navy"]Next[/COLOR] Rw
    [COLOR="Navy"]Next[/COLOR] Ac
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Code:
[COLOR="Navy"]Sub[/COLOR] MG17May16
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Jobs(1 To 10, 1 To 2)
'[COLOR="Green"][B] alter the "10" (Above) to the number of jobs[/B][/COLOR]
'[COLOR="Green"][B]& add to array (below) with proper Job Names and[/B][/COLOR]
'[COLOR="Green"][B]your chosen colour index.[/B][/COLOR]
Jobs(1, 1) = "Jobs1": Jobs(1, 2) = 5 '[COLOR="Green"][B]Alter last number (color Index)as Req'ed from Color Code[/B][/COLOR]
Jobs(2, 1) = "Jobs2": Jobs(2, 2) = 3
Jobs(3, 1) = "Jobs3": Jobs(3, 2) = 6
Jobs(4, 1) = "Jobs4": Jobs(4, 2) = 4
Jobs(5, 1) = "Jobs5": Jobs(5, 2) = 35
Jobs(6, 1) = "Jobs6": Jobs(6, 2) = 6
Jobs(7, 1) = "Jobs7": Jobs(7, 2) = 8
Jobs(8, 1) = "Jobs8": Jobs(8, 2) = 44
Jobs(9, 1) = "Jobs9": Jobs(9, 2) = 7
Jobs(10, 1) = "Jobs10": Jobs(10, 2) = 2
[COLOR="Navy"]Set[/COLOR] Rng = Range("C7:C50")
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]For[/COLOR] n = 1 To UBound(Jobs)
        [COLOR="Navy"]If[/COLOR] Dn.Interior.ColorIndex = Jobs(n, 2) [COLOR="Navy"]Then[/COLOR]
            Dn.Offset(, 10) = Jobs(n, 1)
             [COLOR="Navy"]Exit[/COLOR] For
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Yes this is how I amended it

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim Cell As Range
Dim Rng1 As Range
Range("C10:C50").Select
Set Rng1 = Selection
For Each Cell In Rng1
Select Case Cell.Interior.ColorIndex
Case 43
Cell.Offset(rowoffset:=0, columnoffset:=10).Value = "Alpha"
Case 3
Cell.Offset(rowoffset:=0, columnoffset:=10).Value = "Urgent Phone"
Case 24
Cell.Offset(rowoffset:=0, columnoffset:=10).Value = "Urgent"
End Select
Next




End Sub
 
Upvote 0
Run this first code in a new sheet, it will give you a range of colours and their index number.
Try using the new code below for Inserting "Job" Titles in column "M".
Add/modify the fixed array in code for you particular job Titles and the related colour index, see:- Code Remarks.

Code:
[COLOR="Navy"]Sub[/COLOR] MG17May33
[COLOR="Navy"]Dim[/COLOR] Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Rw [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
    [COLOR="Navy"]For[/COLOR] Ac = 1 To 8 [COLOR="Navy"]Step[/COLOR] 2
        [COLOR="Navy"]For[/COLOR] Rw = 1 To 12
            c = c + 1
            Cells(Rw, Ac) = c
            Cells(Rw, Ac + 1).Interior.ColorIndex = c
        [COLOR="Navy"]Next[/COLOR] Rw
    [COLOR="Navy"]Next[/COLOR] Ac
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Code:
[COLOR="Navy"]Sub[/COLOR] MG17May16
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Jobs(1 To 10, 1 To 2)
'[COLOR="Green"][B] alter the "10" (Above) to the number of jobs[/B][/COLOR]
'[COLOR="Green"][B]& add to array (below) with proper Job Names and[/B][/COLOR]
'[COLOR="Green"][B]your chosen colour index.[/B][/COLOR]
Jobs(1, 1) = "Jobs1": Jobs(1, 2) = 5 '[COLOR="Green"][B]Alter last number (color Index)as Req'ed from Color Code[/B][/COLOR]
Jobs(2, 1) = "Jobs2": Jobs(2, 2) = 3
Jobs(3, 1) = "Jobs3": Jobs(3, 2) = 6
Jobs(4, 1) = "Jobs4": Jobs(4, 2) = 4
Jobs(5, 1) = "Jobs5": Jobs(5, 2) = 35
Jobs(6, 1) = "Jobs6": Jobs(6, 2) = 6
Jobs(7, 1) = "Jobs7": Jobs(7, 2) = 8
Jobs(8, 1) = "Jobs8": Jobs(8, 2) = 44
Jobs(9, 1) = "Jobs9": Jobs(9, 2) = 7
Jobs(10, 1) = "Jobs10": Jobs(10, 2) = 2
[COLOR="Navy"]Set[/COLOR] Rng = Range("C7:C50")
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]For[/COLOR] n = 1 To UBound(Jobs)
        [COLOR="Navy"]If[/COLOR] Dn.Interior.ColorIndex = Jobs(n, 2) [COLOR="Navy"]Then[/COLOR]
            Dn.Offset(, 10) = Jobs(n, 1)
             [COLOR="Navy"]Exit[/COLOR] For
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick


Legendary....easily summed up in one word
 
Upvote 0
It seems like you have a working solution now, from Mick, which is great, but my code (as quoted in post #18) works for me - it inserts "Urgent Phone" in M10, if C10 is red, and so on . . .
 
Upvote 0

Forum statistics

Threads
1,224,581
Messages
6,179,668
Members
452,936
Latest member
anamikabhargaw

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