Solved: Searching for a Value and Highlighting if Found

[jo15765]

I am trying to loop through a worksheet and look for "Alpha-Omega" in column A. If "Alpha-Omega" is found, I want to highlight it green. I was trying to work with this to do it via VBA but my code isn't working...

Dim NewWb As Workbook
Dim CurrentWb As Workbook
Dim WsTData As Worksheet
Dim NewWs As Worksheet
Dim Ocell As Range
Dim IC As Boolean

Set WsTData = Worksheets("Test1")
Set CurrentWb = ThisWorkbook
For Each Ocell In WsTData.Range(WsTData.Cells(2, 1), WsTData.Cells(Rows.Count, 45).End(xlUp))
If Ocell.Text = "Alpha-Omega" Then
Worksheets("Test").Cells(NewWs.Rows.Count, 1).End(xlUp).Offset(1, 0).EntireRow.Select.Value = Ocell.EntireRow.Cells.Value
Worksheets("Test").Selection.Interior.ColorInex = 43
Worksheets("Test").Selction.Pattern = xlSolid
IC = True
Exit For
Else
IC = False
End If
Next Ocell
If IC = True Then
For Each Ocell In WsTData.Range(WsTData.Cells(2, 1), WsTData.Cells(WsTData.Rows.Count, 2).End(xlUp))
If Ocell.Text = "Alpha-Omega" Then
NewWs.Cells(NewWs.Rows.Count, 1).End(xlUp).Offset(1, 0).EntireRow.Select.Value = Ocell.EntireRow.Cells.Value
Worksheets("Test").Cells(NewWs.Rows.Count, 1).End(xlUp).Offset(1, 0).EntireRow.Select.Value = Ocell.EntireRow.Cells.Value
Worksheets("Test").Selection.Interior.ColorInex = 43
Worksheets("Test").Selction.Pattern = xlSolid
End If
Next Ocell
End If

I get a debug error of object variable or with block variable not set on my 1st:

Worksheets("Test").Cells(NewWs.Rows.Count, 1).End(xlUp).Offset(1, 0).EntireRow.Select.Value = Ocell.EntireRow.Cells.Value

Can someone shed some insight into this?

[p45cal]

untested, try: Worksheets("Test").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).EntireRow.Value = Ocell.EntireRow.Value
You haven't set NewWs, and a Select removed.

[jo15765]

Removing the NewWS it give me a debug error of object required.

[p45cal]

There is more than one line in the macro containing NewWs.

[jo15765]

Ay ya ya!! I missed the 2nd one! Okay I have removed both of the NewWS and replaced with Worksheets("Test").

What did you mean "a Select removed"

[jo15765]

I modified the code, and got this far...and have it highlighting now. However if I use the AND operator, when it copies the records, it only highlights the 1st record not the And record as well

' Dim NewWb As Workbook
' Dim CurrentWb As Workbook
' Dim WsTData As Worksheet
' Dim NewWs As Worksheet
' Dim Ocell As Range
' Dim IC As Boolean
'
' Set WsTData = Worksheets("Test")
' Set CurrentWb = ThisWorkbook
' For Each Ocell In WsTData.Range(WsTData.Cells(2, 1), WsTData.Cells(Rows.Count, 45).End(xlUp))
' If Ocell.Text = "Alpha-Omega" Then
' Set NewWs = Sheets("Test")
' Sheets("Test").Select
' NewWs.Rows(1).EntireRow.Cells.Value = WsTData.Rows(1).EntireRow.Cells.Value
' With Selection.ENtireRow.Interior
' .ColorIndex = 43
' .Pattern = xlSolid
' IC = True
' Exit For
' Else
' IC = False
' End If
' Next Ocell
' If IC = True Then
' For Each Ocell In WsTData.Range(WsTData.Cells(2, 1), WsTData.Cells(WsTData.Rows.Count, 2).End(xlUp))
' If Ocell.Text = "Alpha-Omega" Then
' NewWs.Cells(NewWs.Rows.Count, 1).End(xlUp).Offset(1, 0).EntireRow.Cells.Value = Ocell.EntireRow.Cells.Value
' End If
' Next Ocell
' End If


I need these cells highlighted on both tabs of the workbook not just the Test tab....

[mdmackillop]

Rather than check each cell in turn, use FindNext. Something like this

Sub Test()
Dim FirstAddress As String
Dim c As Range
Dim Rng As Range
Dim WsTData As Worksheet
Dim txt As String



txt = "Alpha-Omega"


Set WsTData = Worksheets("Test")
With WsTData
Set Rng = Range(.Cells(2, 1), .Cells(Rows.Count, 45).End(xlUp))
End With

With Rng
Set c = .Find(txt, LookIn:=xlValues)
If Not c Is Nothing Then
FirstAddress = c.Address
Do
Cells(c.Row, 1).Resize(, 45).Interior.ColorIndex = 43
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
End If
End With


End Sub

[jo15765]

I have it working with the copying and highlighting on one tab...Will this code highlight "Alpha-Omega" on both tabs?

[mdmackillop]

For more than one sheet, you need to loop either the sheet indices or an array of names

Sub Test()
Dim FirstAddress As String
Dim c As Range
Dim Rng As Range
Dim WsTData As Worksheet
Dim txt As String
Dim arr, a



txt = "Alpha-Omega"

arr = Array("Test1", "Test2", "Test3")

For Each a In arr
With Worksheets(a)
Set Rng = Range(.Cells(2, 1), .Cells(Rows.Count, 45).End(xlUp))
End With

With Rng
Set c = .Find(txt, LookIn:=xlValues)
If Not c Is Nothing Then
FirstAddress = c.Address
Do
Cells(c.Row, 1).Resize(, 45).Interior.ColorIndex = 43
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
End If
End With
Next


End Sub

[p45cal]

What did you mean "a Select removed"your code:
Worksheets("Test").Cells(NewWs.Rows.Count, 1).End(xlUp).Offset(1, 0).EntireRow.Select.Value = Ocell.EntireRow.Cells.Value

[jo15765]

I see where we declare the txt of what to search for and the workbook names of what to loop through, but when I run the code, it highlights all entries in the workbook, on both tabs. Where do I need to add to make it only highlight my txt variable?

Nevermind it was a typo on my part! Boy do I feel silly! How would I use this if there were 2 that I wanted to search for? Obviously I would need to add

Dim txt2 As String

txt2 = "Jumbalaya"

Set c = .Find(txt And txt2, LookIn:=xlValues)


But that debug error, it didn't like that at all!

[mdmackillop]

Modify this line to suit
Cells(c.Row, 1).Resize(, 45).Interior.ColorIndex = 43
eg
c.Interior.ColorIndex = 43

[jo15765]

Oh i got that part, I had a typo when typing my code in and that was flawing the intended results. What I am stuck on now, is:

How would I use this if there were 2 that I wanted to search for? Obviously I would need to add


Dim txt2 As String

txt2 = "Jumbalaya"

Set c = .Find(txt And txt2, LookIn:=xlValues)

[p45cal]

variation of code in mdmackillop's msg #9 (untested):Sub Test()
Dim FirstAddress As String
Dim c As Range
Dim Rng As Range
Dim WsTData As Worksheet
Dim txt ' As String
Dim arr, a
ArrayTxt = Array("Alpha-Omega", "Jumbalaya")
arr = Array("Test1", "Test2", "Test3")
For Each a In arr
With Worksheets(a)
Set Rng = Range(.Cells(2, 1), .Cells(Rows.Count, 45).End(xlUp))
End With
With Rng
For Each txt In ArrayTxt
Set c = .Find(txt, LookIn:=xlValues)
If Not c Is Nothing Then
FirstAddress = c.Address
Do
Cells(c.Row, 1).Resize(, 45).Interior.ColorIndex = 43
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
End If
Next txt
End With
Next
End Sub

[jo15765]

p45cal when using that code I get a compile error of For Each control variable must be variant or object

On For Each txt In ArrayTxt

I changed txt to Variant type and now it will highlight. Will that flaw any of the other coding? I have never used a variant data type?

[p45cal]

p45cal when using that code I get a compile error of For Each control variable must be variant or object

On For Each txt In ArrayTxt

I changed txt to Variant type and now it will highlight. Will that flaw any of the other coding? I have never used a variant data type? I changed txt to variant type too, see that 'as String' was commented out (it's a variant by default). No it won't flaw the rest.

[mdmackillop]

While the code above doesn't really warrant it, consider splitting more complex code into separate Functions or Subs. It makes it easier to follow and maintain, and you can more easily copy and reuse/adapt sections, such as the DoFind routine here

Sub Test()

Dim c As Range
Dim Rng As Range
Dim WsTData As Worksheet
Dim txt
Dim arr, a

ArrayTxt = Array("Alpha-Omega", "Jumbalaya")
arr = Array("Test1", "Test2", "Test3")

For Each a In arr
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
Next a
End Sub


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
'Act on found cell
c.Interior.ColorIndex = 45
Set c = Rng.FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
End If
End Function

[jo15765]

Just one more minor tweak if possible...On the line of code

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
'Act on found cell
'I added Entire Row
c.EntireRow.Interior.ColorIndex = 43
Set c = Rng.FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
End If
End Function

I added EntireRow to the code, because without adding that it was just the one cell that would highlight, but adding entire row causes from column A1 to the end of the workbook to highlight. Is there anyway, to set it to only highlight the columns that contain data?

[p45cal]

change
c.EntireRow.Interior.ColorIndex = 43 to
rng.parent.cells(c.Row,1).resize(,45).Interior.ColorIndex = 43 or to
intersect(c.entirerow,rng.parent.usedrange).Interior.ColorIndex = 43 or to
Union(c.entirerow.SpecialCells(xlCellTypeConstants, 23), c.entirerow.SpecialCells(xlCellTypeFormulas, 23)).Interior.ColorIndex = 43

[jo15765]

That worked perfectly, thank the both of you for the assistance!

So I can re-use this function, how could I set it to cycle through different worksheet names And if the ArrayTxt does not exist in the open worksheet, then skip.


Dim FirstAddress As String
Dim c As Range
Dim Rng As Range
Dim WsTData As Worksheet
Dim txt As Variant
Dim arr, A

ArrayTxt = Array("Alpha-Omega", "Jumbalaya", "Bicardi", "Cola")

arr = Array("Test1", "Test2", "Test3", "Test4", "Test5")

For Each A In arr
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
Next A
End Function

[p45cal]

how could I set it to cycle through different worksheet namesIt already does this.



And if the ArrayTxt does not exist in the open worksheet, then skip.It's not worth checking if all of the ArrayTxt values are absent, the DoFind sub does that quickly anyway, doing nothing if nothing is found then returning to the main sub.

[jo15765]

It appears to me to only cycle through worksheets from within the Active or Open workbook. Let's say that sheets Bacardi and Cola belong to Workbook2 and sheets "Alpha-Omega", "Jumbalaya", belong to workbook 1. When I add all 4 worksheet names into the ArrayTxt and all workbook names into the arr I get a debug error. That's why I was asking how to modify the code to allow for multiple workbooks/worksheets. Does that make sense what I am asking?

[mdmackillop]

To remind you of your question

I am trying to loop through a worksheet and look for "Alpha-Omega" in column A. If "Alpha-Omega" is found, I want to highlight it green.
We've drifted a long way from that.
Please decide what your new question is and start a new thread.

[jo15765]

Your right, my original question has been answered, thank you both again for the help with that. I started a new thread with my new question here:

http://www.vbaexpress.com/forum/showthread.php?p=255965#post255965