Comparing unique strings in two columns and updating third column

[Snuffle]

Hello

I am trying to find a string in Column D and Column H and if they match certain criteria, insert the string "Match" in Column W.

For example, if the string "Auditorium" occurs in Column D and the string "INTERNAL" occurs in Column H on the same row, insert the string "Match" in Column W.

My code below inserts the string "Match" in Column W against all rows that contain the string "INTERNAL" irrespective of the string in Column D!

Any advice would be appreciated!

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Row No[/TD]
[TD]Column D[/TD]
[TD]Column H[/TD]
[TD]Column W[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Auditorium[/TD]
[TD]Martin (INTERNAL)[/TD]
[TD]None commercial rate[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]Auditorium[/TD]
[TD]John[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]Theatre[/TD]
[TD]Edward (INTERNAL)[/TD]
[TD]None commercial rate[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]Theatre[/TD]
[TD]George[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

Dim celA
Dim celB
For Each celA In Range("D1:D50")[INDENT]For Each celB In Range("H1:H50")[/INDENT]
[INDENT]         If InStr(1, celA.Value, "Auditorium") <> 0 And InStr(1, celB.Value, "INTERNAL") <> 0 Then celB.Offset(0, 10).Value = "None commercial rate"[/INDENT]
[INDENT]Next celB[/INDENT]
Next celA

 

[Vbagreenhorn1]

try this:

Sub Snuffle()
For Each cl In Range("D1:D50")
If InStr(cl, "Auditorium") > 0 And InStr(cl.Offset(, 4), "INTERNAL") <> 0 Then cl.Offset(, 19) = "Match"
Next
End Sub

 

[Fluff]

If you want the comparisons to be case insensitive

Sub Check()
   Dim Cl As Range
   For Each Cl In Range("D1", Range("D" & Rows.Count).End(xlUp))
      If InStr(1, Cl, "auditorium", vbTextCompare) > 0 And InStr(1, Cl.Offset(, 4), "internal", vbTextCompare) > 0 Then Cl.Offset(, 19) = "Match"
   Next
End Sub