VB Script search within a column in one Wb and find in another WB and Highlight yellow

Hi
I am looking for a way to search all text within each row within one column and find the exact match in another workbook and highlight that cell yellow.

is there an easy script that can run and complete this quickly. it would save me hours of work.

Maybe:

Sub DixieDiver()
Dim x As String
Dim i As Long
Dim y As Range
For i = 2 To Range("A" & Rows.Count).End(3).Row
    x = Range("A" & i).Value
        Set y = Workbooks("Another Workbook.xls").Sheets("Sheet1").Cells.Find(x, LookIn:=xlValues, lookat:=xlWhole)
            If Not y Is Nothing Then
                Workbooks("Another Workbook.xls").Sheets("Sheet1").Cells(y.Row, y.Column).Interior.ColorIndex = 6
            End If
        Set y = Nothing
Next i

End Sub

Sorry i fixed it.

I get an error still. "out of range"

Sub DixieDiver()
Dim x As String
Dim i As Long
Dim y As Range
Workbooks("Missing PI Tags 20141021b.xlsx").Sheets("Jacobs").Activate
For i = 1 To 500
    x = Range("A" & i).Value
        Set y = Workbooks("DB (Old App).xlsx").Sheets("DB (Old App)").Columns(1).Find(x, LookIn:=xlValues, lookat:=xlWhole)
            If Not y Is Nothing Then
                Workbooks("DB (Old App).xlsx").Sheets("DB (Old App)").Cells(y.Row, y.Column).Interior.ColorIndex = 6
            End If
        Set y = Nothing
Next i

End Sub

Hi Dixie,

If your search column for the 2nd workbook is also similar as "A" then try this code.

If it's a fixed column, however a different one than you can amend "1" to whatever you'd like under "ImportWB"

Paste in a new module

Option Explicit
Option Compare Text
Sub HighLightText()
Dim i As Integer, counter As Integer, ExportWb As Object, ImportWb As Object, lr As Range
i = 1
counter = 1
Set ExportWb = Workbooks("DB (Old App).xlsx").Sheets("DB (Old App)").Cells
Set ImportWb = Workbooks("Missing PI Tags 20141021b.xlsx").Sheets("Jacobs").Cells
Set lr = Workbooks("Missing PI Tags 20141021b.xlsx").Sheets("Jacobs").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
Do While i < 501
Do While counter < lr.Row + 1
If ExportWb(i, 1).Value = ImportWb(counter, 1).Value Then
ImportWb(counter, 1).Interior.ColorIndex = 6
End If
counter = counter + 1
Loop
counter = 1
i = i + 1
Loop
MsgBox ("The task has been completed"), vbInformation
End Sub

If you want to search the entire sheet with all the columns then you can use John's Code.

Just try removing

Workbooks("Missing PI Tags 20141021b.xlsx").Sheets("Jacobs").Activate

Jayesh25

your code runs without error, but I still don't see the code highlighting the cells yellow when it finds a match. Just to clarify, in column A1:A500 i have tag names in the missing PI tags workbook. I want to search for those tags in the DB workbook in Column A1:A50000 and highlight the cells yellow when found.

Thanks for you guy's quick response. Very much appreciated

DixieDiver,

I had set the workbook names the other way around. Retry the below code? I've changed the route from Missing Tags > DB now

Option Explicit
Option Compare Text
Sub HighLightText()
Dim i As Integer, counter As Integer, ExportWb As Object, ImportWb As Object, lr As Range
i = 1
counter = 1
Set ImportWb = Workbooks("DB (Old App).xlsx").Sheets("DB (Old App)").Cells
Set ExportWb = Workbooks("Missing PI Tags 20141021b.xlsx").Sheets("Jacobs").Cells
Set lr = Workbooks("DB (Old App).xlsx").Sheets("DB (Old App)").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
Do While i < 501
Do While counter < lr.Row + 1
If ExportWb(i, 1).Value = ImportWb(counter, 1).Value Then
ImportWb(counter, 1).Interior.ColorIndex = 6
End If
counter = counter + 1
Loop
counter = 1
i = i + 1
Loop
MsgBox ("The task has been completed"), vbInformation
End Sub

Awesome that worked great
Thank you thank you thank you

Most welcome

Just thought of an enhancement for this code that would be helpful. using the code above how would I also highlight the tags that could not be found Red in the original document "Missing PI Tags 20141021b.xlsx"

Hi Dixie.

I've made some modifications. Try this?

Option Explicit
Option Compare Text
Sub HighLightText()
Dim i As Integer, counter As Integer, ExportWb As Object, ImportWb As Object, lr As Range, Foundit as integer
i = 1
counter = 1
Set ImportWb = Workbooks("DB (Old App).xlsx").Sheets("DB (Old App)").Cells
Set ExportWb = Workbooks("Missing PI Tags 20141021b.xlsx").Sheets("Jacobs").Cells
Set lr = Workbooks("DB (Old App).xlsx").Sheets("DB (Old App)").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
Do While i < 501
Do While counter < lr.Row + 1
If ExportWb(i, 1).Value = ImportWb(counter, 1).Value Then
Foundit = 1
ImportWb(counter, 1).Interior.ColorIndex = 6
End If
counter = counter + 1
Loop
if Foundit = 1 Then
ExportWb(i, 1).Interior.ColorIndex = 3
End If
Foundit = 0
counter = 1
i = i + 1
Loop
MsgBox ("The task has been completed"), vbInformation
End Sub

Worked like champ, just had to change the second if found it =1 to 0

Thanks again