Thread: Reusing code
View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Andym Andym is offline
external usenet poster
 
Posts: 35
Default 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