VBA To Highlight matching cells other workbooks

[Ben H]

Hi

I have a series of hr reports, although these vary the column with the employee number in it does not change. If I were to highlight a cell in the primary workbook can I get excel to highlight the cells in other workbooks? In that way I can find and delete unwanted data from the various workbook.

I basically want to find all hr employees and remove their records from the reports on the different workbooks.

I thought maybe the easiest approach to this would just be some way of highlight in a colour the records I want to remove in the main workbook and then all the sub workbooks have that matching cell contents hightlighted in the same cell so I can filter on colour and remove the unwanted rows for each of the sub workbooks.

Is this possible?

Kind Regards

Ben

 

[Luke M]

Sure thing Ben. We could have the macro even delete the rows for you, but to start simple, here's a macro that will highlight every workbook/worksheet with a matching value.

Sub HighlightRows()
'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 = 3


'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.EntireRow.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

 

[Ben H]

Sub Highlight_Duplicate()

Dim loop_sheet As Integer

Dim sheet_usedrow As Long

Dim loop_row As Long

Dim compare_value As String

Dim loop_row_first_sheet As Long

Dim first_row_count As Long

Dim column_number As Integer

column_number = 1 ' Change the column_number as the column which you want to highlight.

first_row_count = Sheets(1).UsedRange.Rows.Count

For loop_row_first_sheet = 2 To first_row_count

compare_value = Sheets(1).Cells(loop_row_first_sheet, column_number)

  For loop_sheet = 2 To 6

  sheet_usedrow = Sheets(loop_sheet).UsedRange.Rows.Count

  For loop_row = 2 To sheet_usedrow

  If Sheets(loop_sheet).Cells(loop_row, column_number) = compare_value Then

  Sheets(loop_sheet).Activate

  ActiveSheet.Cells(loop_row, column_number).Select

  With Selection.Interior

  .Pattern = xlSolid

  .PatternColorIndex = xlAutomatic

  .Color = 255

  .TintAndShade = 0

   .PatternTintAndShade = 0

  End With

  End If

  Next

  Next

  Sheets(1).Activate

  ActiveSheet.Cells(loop_row_first_sheet, column_number).Select

  With Selection.Interior

  .Pattern = xlSolid

  .PatternColorIndex = xlAutomatic

  .Color = 255

  .TintAndShade = 0

  .PatternTintAndShade = 0

  End With


Next

End Sub

There was one issue though - ive got around 20 separate workbooks and it doesn't seem to work across all of those - any suggestions how it can adapted for working across all those workbooks would be much appreciated.

 

[Luke M]

Hi Ben.

In the future, please remember to use the [code] and [/code] tags around your code, as it makes it much easier to read and preserves indenting. I've no idea what the current problem is, as "it doesn't seem to work" is not very descriptive. Does the macro crash? Does it do something unexpected? Not doing what you want?

Also, it looks like your macro is nothing like the one I posted...so I'm not sure now if the problem was even with my macro (did you try it??), or with your new one?

 

[Ben H]

I am trying to get the vba to highlight all the cells from a that match a list of employee numbers on one sheet, that way I can remove those numbers from my various workbooks. When I run the code i have sent through it hightlights in some of the workbooks but doesnt highlight in all the workbooks - its as if its got a limit to how many of the workbooks its capable of highlighting within?

 

[Ben H]

Does your VBA just look at one active cell? Where the vba I am using looks at a list of employee numbers and finds those numbers in the other workbooks

 

[Luke M]

The code you posted doesn't have anything in it which selects other workbooks. If you look at the code I posted, you'll see how I built in a loop to go through multiple workbooks.

 

[Ben H]

When i run your code I get an error message "no value given", i am unsure as to why?

 

[Luke M]

Does your VBA just look at one active cell? Where the vba I am using looks at a list of employee numbers and finds those numbers in the other workbooks

To start, but you could make it be whatever you want. Example:

Sub HighlightRows()
'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
Dim checkRng As Range
Dim c As Range

'Highlight things in red
myCol = 3

'Where is list of items?
Set checkRng = Worksheets("Sheet1").Range("A2:A10")
For Each c In checkRng
   
    fString = c.Value
   
    '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.EntireRow.Interior.ColorIndex = myCol
                        Set fCell = .FindNext(fCell)
                    Loop Until fCell.Address = firstAdd
                End If
            End With
        Next ws
    Next wb
Next c
Application.ScreenUpdating = True

End Sub

 

[Ben H]

is it due to ...
'Code will highlight all rows in all open workbooks
'which contain the same text as active cell

Does this mean it can only look for text in one cell, rather than a list format?

 

[Ben H]

Hi I tried your vba code and it gave a me a script error 9 message?

 

[Luke M]

The green lines are just comments, don't actually do anything. You can ignore it in the latest, as I changed it to a looping code over a range. If you read the macro, you'll notice it asked that

'Where is list of items?
Set checkRng = Worksheets("Sheet1").Range("A2:A10")

If after fixing that line to correctly point to where your list is, if you still get the error message, let me know what line in the code caused the error please.

 

[Dexter]

Hi Luke M, found your code above and tried to use it for my data. It finds the duplicate in sheet2 and highlights the row correctly, but it also highlights the whole of sheet1. I haven't been able to figure out what part of the code would need to be corrected?