Find numbers across all Worksheets

bradjedis
4StarLounger
Posts: 489
Joined: 30 Mar 2010, 18:49
Location: United States

Find numbers across all Worksheets

Post by bradjedis »

Greetings,

I have a Situation where I have a workbook 100 worksheets. I am needing to search through each sheet, and if the data is found, fill the cell with RED.

the List I need to have queried is 9000+lines. Basically, use the numbers in col A of the 9000 long list and search thru the workbook to find the number. If found background cell color = red. Ignoring the source worksheet..

To make it easier the target data is only in col A.


Regards,
Brad

User avatar
HansV
Administrator
Posts: 74683
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Find numbers across all Worksheets

Post by HansV »

Do you want the fill color to be fixed, or could it be done with conditional formatting (so that the highlighting will change when the values change)?
Regards,
Hans

bradjedis
4StarLounger
Posts: 489
Joined: 30 Mar 2010, 18:49
Location: United States

Re: Find numbers across all Worksheets

Post by bradjedis »

Fixed please. Do not intend for the data content to change.


Regards,

User avatar
HansV
Administrator
Posts: 74683
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Find numbers across all Worksheets

Post by HansV »

Here is a macro:

Code: Select all

Sub HighlightCells()
    Dim ws As Worksheet
    Dim wt As Worksheet
    Dim lst As Range
    Dim rng As Range
    Dim cel As Range
    Application.ScreenUpdating = False
    ' Worksheet with source list
    Set ws = Worksheets("List") ' change name as needed
    ' The source list
    Set lst = ws.Range(ws.Range("A2"), ws.Range("A" & ws.Rows.Count).End(xlUp))
    ' Loop through the worksheets
    For Each wt In Worksheets
        ' Ignore the source sheet
        If wt.Name <> ws.Name Then
            ' Used range in column A
            Set rng = wt.Range(wt.Range("A2"), wt.Range("A" & wt.Rows.Count).End(xlUp))
            ' Optional: reset fill color
            'rng.Interior.ColorIndex = xlColorIndexNone
            For Each cel In rng
                ' Does the cell's value occur in the source list?
                If Not lst.Find(What:=cel.Value, LookAt:=xlWhole) Is Nothing Then
                    ' If so, color the cell red
                    cel.Interior.Color = vbRed
                End If
            Next cel
        End If
    Next wt
    Application.ScreenUpdating = True
End Sub
Sample workbook attached.

P.S. I don't know how long it will take to run the macro in a real-world situation.

FindHighlight.xlsm
You do not have the required permissions to view the files attached to this post.
Regards,
Hans

bradjedis
4StarLounger
Posts: 489
Joined: 30 Mar 2010, 18:49
Location: United States

Re: Find numbers across all Worksheets

Post by bradjedis »

Thanks Hans, Will give it a go and reply!

snb
3StarLounger
Posts: 252
Joined: 14 Nov 2012, 16:06

Re: Find numbers across all Worksheets

Post by snb »

I don't see any argument against conditional formatting:

Code: Select all

Sub M_snb()
  With Sheet2.Columns(1)
    .FormatConditions.Add(2, , "=COUNTIF('List'!A:A;$A1)").Interior.Color = vbRed
    .Copy
  End With

  For Each it In Sheets
    If it.Name <> "List" Then it.Columns(1).PasteSpecial -4122
  Next
End Sub

bradjedis
4StarLounger
Posts: 489
Joined: 30 Mar 2010, 18:49
Location: United States

Re: Find numbers across all Worksheets

Post by bradjedis »

Hans,

Your approach worked well. Let it run after finishing the work day, but it finished in a few hrs.

snb: I will give yours a go as well.

snb
3StarLounger
Posts: 252
Joined: 14 Nov 2012, 16:06

Re: Find numbers across all Worksheets

Post by snb »

This won't take hours to complete
Assumption the numbers in column 1 start in cell A2

Code: Select all

Sub M_snb()
  sn = Sheet1.Columns(1).SpecialCells(2, 1)
  With CreateObject("scripting.dictionary")
    For j = 1 To UBound(sn)
      x0 = .Item(sn(j, 1))
    Next
    
    For Each it In Sheets
      If it.Name <> "List" Then
        sn = it.Columns(1).SpecialCells(2, 1)
        For j = 1 To UBound(sn)
          If .exists(sn(j, 1)) Then it.Columns(1).Cells(j + 1).Interior.Color = vbRed
        Next
      End If
     Next
   End With
End Sub