colour cells using VBA

[Lise]

Hi

New to VBA so apologies in advance if a dumb question!

I have managed to get to the following which is working well but I now want
corresponding cells in the "k" column to change to specific colours based on
the data in "I" and "J" columns and seem to have put myself in a corner -
what os the best way to write such a request please?

'Convert to FMECA format, and set matrix row
If consequence = "A - Almost Certain" Or LCase(consequence) = "a" Or
LCase(consequence) = "a" Or LCase(consequence) = "almost certain" Then
Range("i" & iRow).Value = "A - Almost Certain"
iconsequence = 1
ElseIf consequence = "B - Likely" Or LCase(consequence) = "b" Or
LCase(consequence) = "l" Or LCase(consequence) = "likely" Then
Range("i" & iRow).Value = "B - Likely"
iconsequence = 2
ElseIf consequence = "C - Possible" Or LCase(consequence) = "c" Or
LCase(consequence) = "p" Or LCase(consequence) = "possible" Then
Range("i" & iRow).Value = "C - Possible"
iconsequence = 3
ElseIf consequence = "D - Unlikely" Or LCase(consequence) = "d" Or
LCase(consequence) = "u" Or LCase(consequence) = "unlikely" Then
Range("i" & iRow).Value = "D - Unlikely"
iconsequence = 4
ElseIf consequence = "E - Rare" Or LCase(consequence) = "e" Or
LCase(consequence) = "r" Or LCase(consequence) = "rare" Then
Range("i" & iRow).Value = "E - Rare"
iconsequence = 5

'Convert to FMECA format, and set matrix column
End If
If likelihood = "5 - Catastrophic" Or likelihood = "5" Or
LCase(likelihood) = "ca" Or LCase(likelihood) = "5" Or LCase(likelihood) =
"catastrophic" Then
Range("j" & iRow).Value = "5 - Catastrophic"
ilikelihood = 5
ElseIf likelihood = "4 - Major" Or likelihood = "4" Or LCase(likelihood)
= "ma" Or LCase(likelihood) = "4" Or LCase(likelihood) = "major" Then
Range("j" & iRow).Value = "4 - Major"
ilikelihood = 4
ElseIf likelihood = "3 - Moderate" Or likelihood = "3" Or
LCase(likelihood) = "mo" Or LCase(likelihood) = "3" Or LCase(likelihood) =
"moderate" Then
Range("j" & iRow).Value = "3 - Moderate"
ilikelihood = 3
ElseIf likelihood = "2 - Minor" Or likelihood = "2" Or LCase(likelihood)
= "mi" Or LCase(likelihood) = "2" Or LCase(likelihood) = "minor" Then
Range("j" & iRow).Value = "2 - Moderate"
ilikelihood = 2
ElseIf likelihood = "1 - Insignificant" Or likelihood = "1" Or
LCase(likelihood) = "in" Or LCase(likelihood) = "1" Or LCase(likelihood) =
"insignificant" Then
Range("j" & iRow).Value = "1 - Insignificant"
ilikelihood = 1
Else
ilikelihood = "0"

 

[Jacob Skaria]

Lise

I have rewritten the code and used SELECT/CASE statements which will reduce
the code..The line Range("K" & irow).Interior.ColorIndex = 3 + iconsequence
will change the color of cell K based on the value of the variable
iconsequence. Hope this helps

'/Convert to FMECA format, and set matrix row
Select Case UCase(Left(consequence, 1))
Case "A"
Range("i" & irow).Value = "A - Almost Certain"
iconsequence = 1
Case "B", "L"
Range("i" & irow).Value = "B - Likely"
iconsequence = 2
Case "C", "P"
Range("i" & irow).Value = "C - Possible"
iconsequence = 3
Case "D", "U"
Range("i" & irow).Value = "D - Unlikely"
iconsequence = 4
Case "E", "R"
Range("i" & irow).Value = "E - Rare"
iconsequence = 5
'/Convert to FMECA format, and set matrix column
End Select
Range("K" & irow).Interior.ColorIndex = 3 + iconsequence

Select Case UCase(Trim(Left(likelihood, 2)))
Case "5", "CA"
Range("j" & irow).Value = "5 - Catastrophic"
ilikelihood = 5
Case "4", "MA"
Range("j" & irow).Value = "4 - Major"
ilikelihood = 4
Case "3", "MO"
Range("j" & irow).Value = "3 - Moderate"
ilikelihood = 3
Case "2", "MI"
Range("j" & irow).Value = "2 - Moderate"
ilikelihood = 2
Case "1", "IN"
Range("j" & irow).Value = "1 - Insignificant"
ilikelihood = 1
Case Else
ilikelihood = 0
End Select

 

[Kiwi]

Hi Jacob sorry its taken me a while to come back I have been trying to fiddle
- but to no avail - perhaps i should have given you the whole page. I just
cant get the colours to do what I want - tried entering your part but still
nothing.


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim old As Integer
Dim matrix(1 To 6, 1 To 4) As String
Dim cellcolour(1 To 6, 1 To 4) As Integer

iMatrixRow = 1
iMatrixColumn = 1
For iColumn = 3 To 6
For iRow = 5 To 10
matrix(iMatrixRow, iMatrixColumn) = Sheets("Tables").Cells(iRow,
iColumn).Value
cellcolour(iMatrixRow, iMatrixColumn) = Sheets("Tables").Cells(iRow,
iColumn).Interior.ColorIndex
iMatrixRow = iMatrixRow + 1
Next iRow
iMatrixRow = 1
iMatrixColumn = iMatrixColumn + 1
Next iColumn
'Change E to H
'Change C to I
'Change F to J
For iRow = 6 To 100
consequence = Range("I" & iRow).Value
likelihood = Range("J" & iRow).Value
'determine old cell contents to see if it changes. If not, do not update
colour else it will affect copy and paste function on the worksheet.
oldrisk = Range("K" & iRow).Value

'Convert to FMECA format, and set matrix row
If consequence = "A - Almost Certain" Or LCase(consequence) = "a" Or
LCase(consequence) = "a" Or LCase(consequence) = "almost certain" Then
Range("i" & iRow).Value = "A - Almost Certain"
iconsequence = 1
ElseIf consequence = "B - Likely" Or LCase(consequence) = "b" Or
LCase(consequence) = "l" Or LCase(consequence) = "likely" Then
Range("i" & iRow).Value = "B - Likely"
iconsequence = 2
ElseIf consequence = "C - Possible" Or LCase(consequence) = "c" Or
LCase(consequence) = "p" Or LCase(consequence) = "possible" Then
Range("i" & iRow).Value = "C - Possible"
iconsequence = 3
ElseIf consequence = "D - Unlikely" Or LCase(consequence) = "d" Or
LCase(consequence) = "u" Or LCase(consequence) = "unlikely" Then
Range("i" & iRow).Value = "D - Unlikely"
iconsequence = 4
ElseIf consequence = "E - Rare" Or LCase(consequence) = "e" Or
LCase(consequence) = "r" Or LCase(consequence) = "rare" Then
Range("i" & iRow).Value = "E - Rare"
iconsequence = 5

'Convert to FMECA format, and set matrix column
End If
If likelihood = "5 - Catastrophic" Or likelihood = "5" Or
LCase(likelihood) = "ca" Or LCase(likelihood) = "5" Or LCase(likelihood) =
"catastrophic" Then
Range("j" & iRow).Value = "5 - Catastrophic"
ilikelihood = 5
ElseIf likelihood = "4 - Major" Or likelihood = "4" Or LCase(likelihood)
= "ma" Or LCase(likelihood) = "4" Or LCase(likelihood) = "major" Then
Range("j" & iRow).Value = "4 - Major"
ilikelihood = 4
ElseIf likelihood = "3 - Moderate" Or likelihood = "3" Or
LCase(likelihood) = "mo" Or LCase(likelihood) = "3" Or LCase(likelihood) =
"moderate" Then
Range("j" & iRow).Value = "3 - Moderate"
ilikelihood = 3
ElseIf likelihood = "2 - Minor" Or likelihood = "2" Or LCase(likelihood)
= "mi" Or LCase(likelihood) = "2" Or LCase(likelihood) = "minor" Then
Range("j" & iRow).Value = "2 - Moderate"
ilikelihood = 2
ElseIf likelihood = "1 - Insignificant" Or likelihood = "1" Or
LCase(likelihood) = "in" Or LCase(likelihood) = "1" Or LCase(likelihood) =
"insignificant" Then
Range("j" & iRow).Value = "1 - Insignificant"
ilikelihood = 1
Else
ilikelihood = "0"
End If
'set matrix number in HRI cell
If ilikelihood >= 1 And ilikelihood <= 6 And iconsequence >= 1 And
iconsequence <= 4 Then
Range("K" & iRow).Value = matrix(ilikelihood, iconsequence)
'update new cell colours, only if HRI number has changed
If Range("K" & iRow).Value <> oldrisk Then
Range("K" & iRow).Interior.ColorIndex = cellcolour(ilikelihood,
iconsequence)
End If
'update cell colour if matrix colour changes
If Range("K" & iRow).Interior.ColorIndex <> cellcolour(ilikelihood,
iconsequence) Then
Range("K" & iRow).Interior.ColorIndex = cellcolour(ilikelihood,
iconsequence)
End If
Else 'delete matrix number in HRI cell
Range("K" & iRow).Value = ""
'clear old HRI cell colour if no longer valid
Range("K" & iRow).Interior.ColorIndex = 0
End If

Next iRow


iMatrixRow = 1
iMatrixColumn = 1
For iColumn = 3 To 6
For iRow = 5 To 10
matrix(iMatrixRow, iMatrixColumn) = Sheets("Tables").Cells(iRow,
iColumn).Value
cellcolour(iMatrixRow, iMatrixColumn) = Sheets("Tables").Cells(iRow,
iColumn).Interior.ColorIndex
iMatrixRow = iMatrixRow + 1
Next iRow
iMatrixRow = 1
iMatrixColumn = iMatrixColumn + 1
Next iColumn
'Change H to L
'Change I to M
'Change J to N
For iRow = 6 To 100
consequence = Range("M" & iRow).Value
likelihood = Range("N" & iRow).Value
'determine old cell contents to see if it changes. If not, do not update
colour else it will affect copy and paste function on the worksheet.
oldrisk = Range("O" & iRow).Value

'Convert to FMECA format, and set matrix row
If consequence = "A - Almost Certain" Or LCase(consequence) = "a" Or
LCase(consequence) = "ac" Or LCase(consequence) = "almost certain" Then
Range("M" & iRow).Value = "A - Almost Certain"
iconsequence = 1
ElseIf consequence = "B - Likely" Or LCase(consequence) = "b" Or
LCase(consequence) = "l" Or LCase(consequence) = "likely" Then
Range("M" & iRow).Value = "B - Likely"
iconsequence = 2
ElseIf consequence = "C - Possible" Or LCase(consequence) = "c" Or
LCase(consequence) = "p" Or LCase(consequence) = "possible" Then
Range("M" & iRow).Value = "C - Possible"
iconsequence = 3
ElseIf consequence = "D - Unlikely" Or LCase(consequence) = "d" Or
LCase(consequence) = "u" Or LCase(consequence) = "unlikely" Then
Range("M" & iRow).Value = "D - Unlikely"
iconsequence = 4
ElseIf consequence = "E - Rare" Or LCase(consequence) = "e" Or
LCase(consequence) = "r" Or LCase(consequence) = "rare" Then
Range("M" & iRow).Value = "E - Rare"
iconsequence = 5

Else
iconsequence = "0"
End If
'Convert to FMECA format, and set matrix column
If likelihood = "5 - Catastrophic" Or likelihood = "5" Or
LCase(likelihood) = "ca" Or LCase(likelihood) = "5" Or LCase(likelihood) =
"catastrophic" Then
Range("N" & iRow).Value = "5 - Catastrophic"
ilikelihood = 5
ElseIf likelihood = "4 - Major" Or likelihood = "4" Or LCase(likelihood)
= "ma" Or LCase(likelihood) = "4" Or LCase(likelihood) = "major" Then
Range("N" & iRow).Value = "4 - Major"
ilikelihood = 4
ElseIf likelihood = "3 - Moderate" Or likelihood = "3" Or
LCase(likelihood) = "mo" Or LCase(likelihood) = "3" Or LCase(likelihood) =
"moderate" Then
Range("N" & iRow).Value = "3 - Moderate"
ilikelihood = 3
ElseIf likelihood = "2 - Minor" Or likelihood = "2" Or LCase(likelihood)
= "mi" Or LCase(likelihood) = "2" Or LCase(likelihood) = "minor" Then
Range("N" & iRow).Value = "2 - Moderate"
ilikelihood = 2
ElseIf likelihood = "1 - Insignificant" Or likelihood = "1" Or
LCase(likelihood) = "in" Or LCase(likelihood) = "1" Or LCase(likelihood) =
"insignificant" Then
Range("N" & iRow).Value = "1 - Insignificant"
ilikelihood = 1
Else
ilikelihood = "0"
End If
'set matrix number in HRI cell
If ilikelihood >= 1 And ilikelihood <= 6 And iconsequence >= 1 And
iconsequence <= 4 Then
Range("O" & iRow).Value = matrix(ilikelihood, iconsequence)
'update new cell colours, only if HRI number has changed
If Range("O" & iRow).Value <> oldrisk Then
Range("O" & iRow).Interior.ColorIndex = cellcolour(ilikelihood,
iconsequence)
End If
'update cell colour if matrix colour changes
If Range("O" & iRow).Interior.ColorIndex <> cellcolour(ilikelihood,
iconsequence) Then
Range("O" & iRow).Interior.ColorIndex = cellcolour(ilikelihood,
iconsequence)
End If
Else 'delete matrix number in HRI cell
Range("O" & iRow).Value = ""
'clear old HRI cell colour if no longer valid
Range("O" & iRow).Interior.ColorIndex = 0
End If

Next iRow

End Sub