Reusing code
This should help out a little:
Sub Exclusions()
Call FindExclusions("MatchA", "Failure Code A", "Manual")
Call FindExclusions("MatchB", "Failure Code B", "Manual")
End Sub
Function FindExclusions(findStr As String, writeReason As String,
writeManual As String)
Dim A As Range, retA
ActiveCell.EntireColumn.Select
For Each A In Selection
retA = InStr(1, A, findStr, vbTextCompare)
If (Not IsNull(retA)) And (retA 0) Then
A.Offset(0, -17).Value = writeReason
A.Offset(0, -20).Value = writeManual
End If
Next A
End Function
If you have a very large number of terms to search for, you could also put
all of the terms into a sheet and have the macro loop through each term.
Hope this helps!
Andy
"Blee" wrote:
I'm searching a column for matches (FindThis) and writing to cells on
the row (WriteReason) on success. The macro below works fine, but my
number of matching terms is increasing and I find myself just copying
and pasting the code over and over again. Is there a better way to
modularize this just plug in values without creating "FindThisA,
FindThisB", etc?
----
Sub Exclusions()
WriteManual = "Manual"
Const FindThisA = "MatchA"
Const WriteReasonA = "Failure Code A"
Const FindThisB = "MatchB"
Const WriteReasonB = "Failure Code B"
Dim A As Range, retA
ActiveCell.EntireColumn.Select
For Each A In Selection
retA = InStr(1, A, FindThisA, vbTextCompare)
If (Not IsNull(retA)) And (retA 0) Then
A.Offset(0, -17).Value = WriteReasonA
A.Offset(0, -20).Value = WriteManual
End If
Next A
Dim B As Range, retB
ActiveCell.EntireColumn.Select
For Each B In Selection
retB = InStr(1, B, FindThisB, vbTextCompare)
If (Not IsNull(retB)) And (retB 0) Then
B.Offset(0, -17).Value = WriteReasonB
B.Offset(0, -20).Value = WriteManual
End If
Next B
End Sub
|