archangel0312
New Member
- Joined
- Jun 30, 2017
- Messages
- 2
I have a workbook with 10 sheets of machine parts. On sheet 10, I am going to have the critical parts listed. I want to reference all of the information on sheet 10 in columns A-I, and I want to then highlight the row for every other instance in the workbook.
For example. If I have SAP number "829131" on sheet 10. I want every row that has SAP number "829131" in the entire workbook to be highlighted.
I have no idea where to even start with this. So hopefully you can help me out.
I found something online that I thought I would work, but it only references the active cell and I can't figure out how to make it reference the range I need it to.
For example. If I have SAP number "829131" on sheet 10. I want every row that has SAP number "829131" in the entire workbook to be highlighted.
I have no idea where to even start with this. So hopefully you can help me out.
I found something online that I thought I would work, but it only references the active cell and I can't figure out how to make it reference the range I need it to.
Code:
Sub CriticalSpare()
'Code will highlight all rows in all open workbooks
'which contain the same text as active cell
Dim wb As Workbook
Dim ws As Worksheet
Dim fString As String
Dim firstAdd As String
Dim fCell As Range
Dim myCol As Long
'The item to look for is the active cell
fString = ActiveCell.Value
'Highlight things in red
myCol = 41
'Don't run on a blank cell
If fString = "" Then
MsgBox "No value given"
Exit Sub
End If
Application.ScreenUpdating = False
'Loop through all workbooks...
For Each wb In Application.Workbooks
'...and all worksheets
For Each ws In wb.Worksheets
Set fCell = Nothing
firstAdd = ""
With ws.Cells
'looking for the desired value
Set fCell = .Find(fString)
If Not fCell Is Nothing Then
firstAdd = fCell.Address
Do
'and if found, highlight the row
fCell.Interior.ColorIndex = myCol
Set fCell = .FindNext(fCell)
Loop Until fCell.Address = firstAdd
End If
End With
Next ws
Next wb
Application.ScreenUpdating = True
End Sub