VBA help - to find the multiple strings

[shantraj.antin@gmail.com]

hi Guys,


In the below code I am trying to find the key words "7s" and "6V" from the worksheet "Products". I am able to find and color code only one line Item. I struck to loop it untill it finds all the occurance.


Can someone help me pleae?

***********************************************

Sub FindPremium_PNS()


Dim RngFindTitle As Range


FindWhat = Array("7s", "6v")

Application.ScreenUpdating = False


With Sheets("Products").Range("H:H")


Set RngFindTitle = .Find(FindWhat)


End With


If RngFindTitle Is Nothing Then

MsgBox ("Sorry! No keyword title is found")

Else


RngFindTitle.EntireRow.Interior.Color = RGB(255, 0, 0)


MsgBox ("Premium Products! 7s/6v are hilighted in Red")


End If

End Sub

 

[mercatog]

Hi Shan

A simple loop can do what you want. But, are sure that you will have maximum one row with 7s and one row with 6v?


Try this code who will highlight the first occurence of 7s and 6v if found.

[pre]

Sub FindPremium_PNS()
Dim RngFindTitle As Range
Dim Msg As String
Dim i As Byte
Dim FindWhat

Application.ScreenUpdating = False
FindWhat = Array("7s", "6v")

For i = LBound(FindWhat) To UBound(FindWhat)
With Worksheets("Products").Range("H:H")
Set RngFindTitle = .Find(FindWhat(i), LookIn:=xlValues, lookat:=xlWhole)
End With

If RngFindTitle Is Nothing Then
Msg = Msg & vbNewLine & "Sorry! No keyword " & FindWhat(i) & "title is found"
Else
RngFindTitle.EntireRow.Interior.Color = RGB(255, 0, 0)
Msg = Msg & vbNewLine & "Premium Products! " & FindWhat(i) & " are hilighted in Red"
End If
Next i
MsgBox Msg
End Sub

[/pre]

 

[shantraj.antin@gmail.com]

hi Mercatog,


Yes I have mutilple rows having 7s and 6v. The Above coding is woking only for the first instance search of 6v and 7s. Its fine to mention the message as "Premium Products! 7s/6v are hilighted in Red"


Thank you,

 

[mercatog]

Hi

If you have your data from H2 to Hxx and in H1 the title of the column, better to try this code using an autofilter and then highlights the rows visible if found.

[pre]

Sub FindPremium_PNS()
Dim LastRow As Long

Application.ScreenUpdating = False
With Worksheets("Products")
.AutoFilterMode = False
LastRow = .Cells(.Rows.Count, "H").End(xlUp).Row
.Range("H1:H" & LastRow).AutoFilter field:=1, Criteria1:="7s", Operator:=xlOr, Criteria2:="6v"
If .Range("H1:H" & LastRow).SpecialCells(xlCellTypeVisible).Count > 1 Then
.Rows("2:" & LastRow).SpecialCells(xlCellTypeVisible).Interior.Color = 255
MsgBox "Premium Products! 7s/6v are hilighted in Red"
Else
MsgBox "Sorry! No keyword title is found"
End If
.AutoFilterMode = False
End With
End Sub

[/pre]

 

[shantraj.antin@gmail.com]

Thanks mercatog for your quick support. Much appreciated.