Changing Font Colour for multiple options and entries via drop down list

[Jackman1]

Hi All!

I'm putting a spreadsheet together which will keep a track of potential suppliers I am using and who has quoted and regretted. I am currently using a simple entry method where I can change each on individually

eg cell C2 contains - supplier1, supplier2, supplier3
when I get a response the font colour is changed, ie if supplier1 regrets, the become supplier1, if supplier2 offers they become supplier2.

The result is a simple log of who as offered, who has regretted and who is outstanding. Works Well.

I'm now trying to put another system together which the entries are entered from a drop down using a code to allow multiple entries.....no issue.

The problem is this will not allow the changing of colours of individual entries as previous and above.

Code is below for multiple entries

Code/
Dim Oldvalue As String
Dim Newvalue As String

On Error GoTo Exitsub
If Target.Address = "$C$2" Then
If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
GoTo Exitsub
Else: If Target.Value = "" Then GoTo Exitsub Else
Application.EnableEvents = False
Newvalue = Target.Value
Application.Undo
Oldvalue = Target.Value
If Oldvalue = "" Then
Target.Value = Newvalue
Else
Target.Value = Oldvalue & ", " & Newvalue
End If
End If
End If
Application.EnableEvents = True

Exitsub:
Application.EnableEvents = True

End Sub
\code

Is it possible? Would like to keep the same format is possible.

Thanks for any help offered.

 

[BKrukowski]

Can you show the code that is changing the colors?

 

[Jackman1]

Sorry no code, that is the issue.

Previously I have manually entered suppliers, then manually changed the suppliers to keep a track.

Trying to formalise to help monitor (eg, one person can call a supplier supplier1, someones could call them supp1 for instance). If I make the entry via drop down, all entries will be the which will make for easier reporting on another project.

Once selecting from drop down, cannot manually change.

hope the below helps.

Previous manually entry upon initial entry could read in cell C2

JOES MACHINING, FREDS WORKSHOP, ANDYS GRINDER, ALANS FABRICATORS

After lets say 1 week could read as below with manual changes;

JOES MACHINING, FREDS WORKSHOP, ANDYS GRINDER, ALANS FABRICATORS
Joe and Andy offered (GREEN), alan regretted (RED), fred not replied (very common unfortunately, LEFT AS ENTERED).

When the above a selectable from a drop list in the same cell (via the above code), I am not allowed to change the colours.

Hope this explains fully.

thanks again.

 

[BKrukowski]

Once selecting from drop down, cannot manually change.

To prevent someone from changing a supplier once the supplier is chosen from a dropdown list

-The dropdown list should be created using Data Validation - create a list of suppliers on a different sheet and create a List (select the whole column and in the address box type a name such as Suppliers and hit enter - this way you can add more supplier names to the bottom of the list and not have to change anything in VBA)-
-I will assume that the supplier is always in the same column and use the Worksheet_SelectionChange Event

Private Sub Worksheet_SelectionChange(ByVal Target As Range)  ' This is triggered when a cell is selected 

Dim MySuplyMsg as String       ' Create a string variable to make things easier with MsgBox 
                                                           
MySuplyMsg =  "You are trying to change a supplier that has been contacted!"        'Create your string
MySuplyMsg = MySuplyMsg & vbcrlf &  "Do you wish to change this supplier?"        ' If you chose the wrong supplier then there must be a way to correct it 


If Target.Column = "enter your column Number A=1 , B=2, C=3 etc." Then    ' We don't care if they click on any other cell then the supplier cell

If Target.Value = "" then ' If there has been no supplier set before then exit the sub so the user can enter a supplier
Exit Sub 
else

MsgBoxResult = MsgBox("MySuplyMsg", vbYesNo)           'Provide a way to rename the supplier because of error 

If MsgBoxResult = 6 then  ' 6 = YES  7 = NO
else
Activecell.Offset(0,1).select                                           ' change cells so the user cannot enter something for supplier
End If
End If                                                                          'closing nested ifs
End If

'ABOVE WILL PREVENT CHANGES TO SUPPLIER ONCE IT IS SELECTED

End Sub

As for editing the Color - Is there is a column for the Status -Quoted, Regretted, Awaiting Response also this only highlights the supplier name.

Private Sub Worksheet_Change(ByVal Target As Range) ' This is triggered when there is a change in value of a cell 

If Target.Column = "Enter the column for Status A=1, B=2, C=3 and so on"

Select Case Target.Value

Case Is = "Offered"    ' These must be predefined like the Supplier Names The SPELLING and upper or lower case must be the same on the worksheet as it is here

       Activecell.Offset(0,"Number of columns from Supplier Name (move left use negative number)).Font.Color = vbGreen 

      'If you want the entire Row to have the color then use the line below for each Select Case Construct

     'Rows(Activecell.Row).Font.Color = vbGreen

Case is = "Regretted"

       Activecell.Offset(0,"Number of columns from Supplier Name (move left use negative number)).Font.Color = vbRed

Case Is = "No Reply"

        Activecell.Offset(0,"Number of columns from Supplier Name (move left use negative number)).Font.Color = vbBlack

end select

end sub

I did my best to interpret what you were looking for. The Code needs to be placed in the WorkSheet that the data is in - if it is in multiple sheets you need to add the code to each sheets Events

 

[Jackman1]

Many thanks for your very detailed reply.

The drop works, just trying to not change the current format. With the information you have supplied I think I will add an "Offered and Regret" column. This will probably be better in the long run for future reporting also.

Thanks again. As always MrExcel forum as been a big help.

Regards