Complex search and replace macro based on input variables.
In article , GS writes
Sorry I didn't catch that you wanted to 'flag' amended cells! The
following revision will apply random Font.Color (simple method) to
amended cells for each run...
Hi Garry
OK thanks for this. I'm grateful again for your time and considerable
expertise.
Best Wishes
Sub FindReplace2()
Dim vVals, vRng, sMsg$, n&, k&, lLastRow&, lOffset&
Dim rngSource As range, vNdxs(), bAmends As Boolean
sMsg = "Please enter the label of column to search on, " _
& "the substring to search for, " _
& "the label of column to amend, " _
& "the lower value, " _
& "the upper value the value to amend semocolon-separated"
vVals =
Split(Application.InputBox(sMsg, "Enter Conditions", Type:=2), ";")
'Validate input
' If user cancels or returns an empty string
' OR If missing args
If UBound(vVals) < 5 Then Exit Sub
On Error GoTo ErrExit
lLastRow = Cells(Rows.Count, vVals(0)).End(xlUp).Row
Set rngSource = range(Cells(1, vVals(0)), Cells(lLastRow, vVals(2)))
vRng = rngSource: lOffset = UBound(vRng, 2)
For n = LBound(vRng) To UBound(vRng)
If InStr(vRng(n, 1), vVals(1)) 0 Then
If vRng(n, lOffset) CDbl(vVals(3)) _
And vRng(n, lOffset) < CDbl(vVals(4)) Then
vRng(n, lOffset) = CDbl(vVals(5))
ReDim Preserve vNdxs(k)
vNdxs(k) = n: k = k + 1: bAmends = True
End If
End If
Next 'n
rngSource = vRng: If bAmends Then FlagCells vNdxs, vVals(2)
ErrExit:
Set rngSource = Nothing
End Sub
Sub FlagCells(RowNums(), ByVal ColLabel$)
' Applys a random RGB value to Font.Color
' of specified cells in a specified column.
Dim vRGB(2), n&
Const lMin& = 0: Const lMax& = 255
For n = LBound(vRGB) To UBound(vRGB)
vRGB(n) = Int((lMax - lMin + 1) * Rnd + lMin)
Next 'n
For n = LBound(RowNums) To UBound(RowNums)
Cells(RowNums(n), ColLabel).Font.Color = _
RGB(vRGB(0), vRGB(1), vRGB(2))
Next 'n
End Sub
|