Hi Colin,

Am Mon, 14 Jul 2014 15:34:41 +0100 schrieb Colin Hayes:

A F

12345_LP34 9.5
45234_LP67 3.5
42525_OY43 7.5

Would become

12345_LP34 9.5
45234_LP67 6.5
42525_OY43 7.5

enter into the InputBox e.g.:
A;LP;F;0;5;6.5

Sub ReplaceVal()
Dim strCond As String, FirstAddress As String
Dim arrCond As Variant
Dim LRow As Long
Dim c As Range

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

arrCond = Split(strCond, ";")
LRow = Cells(Rows.Count, Asc(UCase(arrCond(0))) - 64).End(xlUp).Row

Set c = Range(Cells(1, Asc(UCase(arrCond(0))) - 64), Cells(LRow,
Asc(UCase(arrCond(0))) - 64)) _
.Find(arrCond(1), LookIn:=xlValues, lookat:=xlPart)

If Not c Is Nothing Then
FirstAddress = c.Address
Do
If c.Offset(, Asc(UCase(arrCond(2))) -
Asc(UCase(arrCond(0)))) _
CDbl(arrCond(3)) And c.Offset(, Asc(UCase(arrCond(2))) - _
Asc(UCase(arrCond(0)))) < CDbl(arrCond(4)) Then
c.Offset(, Asc(UCase(arrCond(2))) -
Asc(UCase(arrCond(0)))) _
= CDbl(arrCond(5))
c.Offset(, Asc(UCase(arrCond(2))) -
Asc(UCase(arrCond(0)))) _
.Font.Color = vbRed
End If
Set c = Range(Cells(1, Asc(UCase(arrCond(0))) - 64), _
Cells(LRow, Asc(UCase(arrCond(0))) - 64)).FindNext(c)
Loop While Not c Is Nothing And c.Address < FirstAddress
End If
End Sub


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