jo15765
02-26-2012, 11:14 AM
I am running the below code, to search two worksheet names and if they are found highlight them. The problem I am having is that the names are being highlighted if it contains the name contained in the Array, not the full name. For example in the Array, there is a Jo Jo's BBQ Shack, as well as a Jo Jo's BBQ Shack - PA. It is highlighting BOTH of these when only Jo Jo's BBQ Shack is contained in the array. Below is the code I use, can someone help me, correct this please?
Public Sub Highlight_Green_These()
Dim c As Range
Dim Rng As Range
Dim txt As Variant
Dim Arr, a
ArrayTxt = Array("Michael Mountain Equipment", "Jo Jo's BBQ Shack")
Arr = Array("Company Info With Client InfoAddress", "Company Info Only)
For Each a In Arr
If WorkSheetExists(CStr(a)) Then
With Worksheets(a)
Set Rng = .Range(.Cells(2, 1), .Cells(Rows.Count, 45).End(xlUp))
End With
For Each txt In ArrayTxt
DoFind Rng, txt
Next txt
End If
Next a
End Sub
Public Function WorkSheetExists(sWorkSheet As String, Optional sWorkbook As String = "") As Boolean
Dim WS As Worksheet, WB As Workbook
On Error GoTo notExists
If sWorkbook = "" Then
Set WB = ActiveWorkbook
Else
Set WB = Workbooks(sWorkbook)
End If
Set WS = WB.Worksheets(sWorkSheet)
WorkSheetExists = True
Exit Function
notExists:
WorkSheetExists = False
End Function
Public Function DoFind(Rng As Range, ToFind)
Dim FirstAddress As String
Dim c As Range
Set c = Rng.Find(ToFind, LookIn:=xlValues)
If Not c Is Nothing Then
FirstAddress = c.Address
Do
Rng.Parent.Cells(c.Row, 1).Resize(, 45).Interior.ColorIndex = 43
Set c = Rng.FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
End If
End Function
Public Sub Highlight_Green_These()
Dim c As Range
Dim Rng As Range
Dim txt As Variant
Dim Arr, a
ArrayTxt = Array("Michael Mountain Equipment", "Jo Jo's BBQ Shack")
Arr = Array("Company Info With Client InfoAddress", "Company Info Only)
For Each a In Arr
If WorkSheetExists(CStr(a)) Then
With Worksheets(a)
Set Rng = .Range(.Cells(2, 1), .Cells(Rows.Count, 45).End(xlUp))
End With
For Each txt In ArrayTxt
DoFind Rng, txt
Next txt
End If
Next a
End Sub
Public Function WorkSheetExists(sWorkSheet As String, Optional sWorkbook As String = "") As Boolean
Dim WS As Worksheet, WB As Workbook
On Error GoTo notExists
If sWorkbook = "" Then
Set WB = ActiveWorkbook
Else
Set WB = Workbooks(sWorkbook)
End If
Set WS = WB.Worksheets(sWorkSheet)
WorkSheetExists = True
Exit Function
notExists:
WorkSheetExists = False
End Function
Public Function DoFind(Rng As Range, ToFind)
Dim FirstAddress As String
Dim c As Range
Set c = Rng.Find(ToFind, LookIn:=xlValues)
If Not c Is Nothing Then
FirstAddress = c.Address
Do
Rng.Parent.Cells(c.Row, 1).Resize(, 45).Interior.ColorIndex = 43
Set c = Rng.FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
End If
End Function