How to use VB for multiple conditions

[OsmoseTom]

I need some help. I need to change the color of a cell based on values from
a list. The list options are V, F, A, OC, CO, O1, O2, O3, O4, O5, O6, O7, &
O8. Each option would have to be a different color. Can this be done using
VB code for the current worksheet? If so how? Thanks...

 

[Carol]

I have some search coding I am using to create a summary sheet at the back
of a workbook. When the search criteria is met the entire row will e copied
over to the summary tab. What I need to do is also copy the sheet name with
that data so I know exactly where it came from. I don't have a clue how to
do this, can anyone guide me please.

CODING:

Option Explicit
Option Compare Text

Sub SeachSheets()
'
Dim FirstAddress As String, WhatFor As String
Dim Cell As Range, Sheet As Worksheet
'
WhatFor = InputBox("What are you looking for?", "Search Criteria")
If WhatFor = Empty Then Exit Sub
'
For Each Sheet In Sheets
If Sheet.Name <> "SUMMARY" Then
With Sheet.Columns(6)
Set Cell = .Find(WhatFor, LookIn:=xlValues, LookAt:=xlPart)
Set Cell = .Find(WhatFor, LookIn:=xlValues, LookAt:=xlWhole)
If Not Cell Is Nothing Then
FirstAddress = Cell.Address
Do
Cell.EntireRow.Copy _
Destination:=Sheets("SUMMARY").Range("A" &
Rows.Count).End(xlUp).Offset(1, 0)
Set Cell = .FindNext(Cell)
Loop Until Cell Is Nothing Or Cell.Address =
FirstAddress
End If
End With
End If
Next Sheet
'
Set Cell = Nothing
End Sub
Sub Clear()
Range("A4:K50").Select
Selection.ClearContents
Range("J18").Select
End Sub

 

[Gary''s Student]

This is coded for data entry on column A. Put this event macro in the
worksheet code area:

Private Sub Worksheet_Change(ByVal Target As Range)
codes = ("V,F,A,OC,CO,O1,O2,O3,O4,O5,O6,O7,O8")
Acodes = Split(codes, ",")
Set t = Target
Set a = Range("A:A")
If Intersect(t, a) Is Nothing Then Exit Sub
v = t.Value
For i = LBound(Acodes) To UBound(Acodes)
If v = Acodes(i) Then
t.Interior.ColorIndex = i
End If
Next
End Sub

 

[Dave Peterson]

If you want to assign the colors yourself:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim myVals As Variant
Dim myColors As Variant
Dim myColor As Long
Dim Res As Variant

myVals = Array("V", "F", "A", "OC", "CO", _
"O1", "O2", "O3", "O4", _
"O5", "O6", "O7", "O8")

myColors = Array(1, 3, 5, 6, 7, _
12, 2, 13, 22, _
34, 37, 44, 58)

If UBound(myVals) = UBound(myColors) Then
'ok, keep going
Else
MsgBox "Design error!"
Exit Sub
End If

If Target.Cells.Count > 1 Then
Exit Sub 'one cell at a time
End If

If Intersect(Target, Me.Range("a:a")) Is Nothing Then
Exit Sub 'only in column A
End If

Res = Application.Match(Target.Value, myVals, 0)
If IsNumeric(Res) Then
myColor = myColors(Res - 1)
Else
myColor = xlNone
End If

Target.Interior.ColorIndex = myColor

End Sub

When I do this, I record a macro when I change the fill color. Then I look at
the code to see what number that color represented.