Hello,

I have been trying to write some code for days with little luck. I finally thought I had it but the results turned out to be all or nothing versus each individual row. Now I am turning to you kind people for some help.

What I have is a spreadsheet containing 25350 rows (and growing) with 33 columns of data. Column A = Client ID, Column B = Benefit Code, Column C = Benefit description and columns D - AG = billing codes.

Each row may have as little as 1 billing code (so only column D would be populated) or could be maxed out at 30. Also, the billing codes are not listed in any consistant order. What I need to do is cycle through each cell columns D thru AG (row by row) and if any one of these, HP, RW, RO, RU, RI, QS or PI are found I need AH of that row updated with "Yes" Where not found AH can be left blank or populated with "No" it does not matter.

Below are 2 distictly different peices of VBA that I have tried. The last 2, I am not bothering with the first 4 or 5. Code 1 is just as likely to stop responding as it is to finish. The results of both were the same, each and every row was determined to be positive. That leaves me to think that it is checking the entire spreadsheet and if any of the billing codes are found anywhere then the VBA determines it is a success for all rows and that is not what I need.

Any help at all would be greatly appreciated.

Thanks

Rob

Code 1
Sub Med_PPO()
Dim rng As Range
Dim row As Range
Dim cel As Range
Dim mr As Long

Dim mp As Variant, strBelong As String
mp = Array("HP", "RW", "RO", "RI", "RU", "QS", "PI", "IP", "SQ")
mr = 2
Set rng = Range("D:D")

For Each row In rng.Rows
For Each cel In row.Cells
On Error Resume Next
If WorksheetFunction.Match(cel, mp, 0) <> 0 Then
Range("AH" & row) = "Yes"
End If
Next cel
Next row
End Sub

code 2:
Sub Medical_PPO()
Dim DataRange As Variant
Dim Irow As Long
Dim MaxRows As Long
Dim Icol As Long
Dim MaxCols As Long
Dim MyVar As Double
DataRange = Range("d2").CurrentRegion.Value ' Not using set
Dim mp As Variant, strBelong As String
mp = Array("HP", "RW", "RO", "RI", "RU", "QS", "PI", "IP", "SQ")


MaxRows = Range("d2").CurrentRegion.Rows.Count
MaxCols = Range("d2").CurrentRegion.Columns.Count
For Irow = 2 To MaxRows
For Icol = 4 To MaxCols
strBelong = ActiveCell.Value
On Error Resume Next
If WorksheetFunction.Match(strBelong, mp, 0) <> 0 Then
Range("AH" & Irow) = "Yes"

End If

Next Icol

Next Irow
End Sub