Complex search and replace macro based on input variables.
In article , Claus Busch
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.
Hi Claus
OK - Fantastic. I don't know how you do it. Many many thanks.
BTW , it did initially give an 'End IF without Block IF' error.
I remmed this and it seems to run fine anyhow.
Best Wishes
Colin
|