Hi Colin,

Am Mon, 14 Jul 2014 21:16:53 +0100 schrieb Colin Hayes:

Out of curiosity , is there a way to rotate random colours in a macro do
you know?

not all colors are good readable on white background. So I would avoid
random colors. In the following code I inserted an array of 12 fix
colors. After the 12. run the colors are starting new. I hope 12 colors
are enough colors for your project:

Sub ReplaceVal2()
Dim strCond As String, FirstAddress As String
Dim arrCond As Variant, arrClrs As Variant
Dim LRow As Long
Dim c As Range
Dim SCol As Long, ACol As Long

strCond = Application.InputBox _
("Please enter the column to search on, " _
& "the substring, the column to amend, the lower value, " _
& "the uppervalue and the value to amend semicolon-separated", _
"Enter Conditions", Type:=2)

If strCond = "" Or strCond = "False" Then Exit Sub

Application.ScreenUpdating = False

arrCond = Split(strCond, ";")
If UBound(arrCond) < 5 Then Exit Sub

SCol = Asc(UCase(arrCond(0))) - 64
ACol = Asc(UCase(arrCond(2))) - 64
LRow = Cells(Rows.Count, SCol).End(xlUp).Row
arrClrs = Array(3, 4, 5, 6, 10, 11, 25, 26, 32, 45, 46, 55)

Set c = Range(Cells(1, SCol), Cells(LRow, SCol)) _
.Find(arrCond(1), LookIn:=xlValues, lookat:=xlPart)
If Not c Is Nothing Then
FirstAddress = c.Address
Do
If c.Offset(, ACol - SCol) CDbl(arrCond(3)) And _
c.Offset(, ACol - SCol) < CDbl(arrCond(4)) Then
c.Offset(, ACol - SCol) = CDbl(arrCond(5))
c.Offset(, ACol - SCol).Font.ColorIndex =
arrClrs(Range("XFD1").Value)
End If
Set c = Range(Cells(1, SCol), Cells(LRow, SCol)).FindNext(c)
Loop While Not c Is Nothing And c.Address < FirstAddress
End If
Range("XFD1") = IIf(Range("XFD1") = 11, 0, Range("XFD1") + 1)

Application.ScreenUpdating = True
End Sub




Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional