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
Find numbers across all Worksheets
-
- 4StarLounger
- Posts: 538
- Joined: 30 Mar 2010, 18:49
- Location: United States
-
- Administrator
- Posts: 78475
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Find numbers across all Worksheets
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)?
Best wishes,
Hans
Hans
-
- 4StarLounger
- Posts: 538
- Joined: 30 Mar 2010, 18:49
- Location: United States
Re: Find numbers across all Worksheets
Fixed please. Do not intend for the data content to change.
Regards,
Regards,
-
- Administrator
- Posts: 78475
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Find numbers across all Worksheets
Here is a macro:
Sample workbook attached.
P.S. I don't know how long it will take to run the macro in a real-world situation.
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
P.S. I don't know how long it will take to run the macro in a real-world situation.
You do not have the required permissions to view the files attached to this post.
Best wishes,
Hans
Hans
-
- 4StarLounger
- Posts: 538
- Joined: 30 Mar 2010, 18:49
- Location: United States
Re: Find numbers across all Worksheets
Thanks Hans, Will give it a go and reply!
-
- 4StarLounger
- Posts: 574
- Joined: 14 Nov 2012, 16:06
Re: Find numbers across all Worksheets
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
-
- 4StarLounger
- Posts: 538
- Joined: 30 Mar 2010, 18:49
- Location: United States
Re: Find numbers across all Worksheets
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.
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.
-
- 4StarLounger
- Posts: 574
- Joined: 14 Nov 2012, 16:06
Re: Find numbers across all Worksheets
This won't take hours to complete
Assumption the numbers in column 1 start in cell A2
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