Thanks for your great tutorial. How can I remove Case Sensitive option and just type words and search? (Capitalization is not used in my language writing). Also how can I add the desired heading of various sheets to the results? (Headings vary in my worksheets)
Hello @alpaynamazi, You are most welcome. We updated the VBA code: 1. To remove case sensitive option from the search result. 2. To Highlight the searched word. 3. To add headers from different sheets if match data is found. VBA Code: Sub SearchMultipleSheets_Updated() Main_Sheet = "VBA" Search_Cell = "B5" Paste_Cell = "B9" Searched_Sheets = Array("Dataset 1", "Dataset 2") Searched_Ranges = Array("B5:F23", "B5:F23") Copy_Format = True Last_Row = Sheets(Main_Sheet).Range(Paste_Cell).End(xlDown).Row Last_Column = Sheets(Main_Sheet).Range(Paste_Cell).End(xlToRight).Column Set Used_Range = Sheets(Main_Sheet).Range(Cells(Range(Paste_Cell).Row, Range(Paste_Cell).Column), Cells(Last_Row, Last_Column)) Used_Range.ClearContents Used_Range.ClearFormats Value1 = Sheets(Main_Sheet).Range(Search_Cell).Value ' No lowercase conversion Count = -1 For S = LBound(Searched_Sheets) To UBound(Searched_Sheets) Set Rng = Sheets(Searched_Sheets(S)).Range(Searched_Ranges(S)) Dim headerCopied As Boolean headerCopied = False ' To keep track if the header has been copied ' Start searching the range For i = 2 To Rng.Rows.Count ' Start from 2 to skip the header row For j = 1 To Rng.Columns.Count Value2 = Rng.Cells(i, j).Value If InStr(1, Value2, Value1) > 0 Then ' Check for match If Not headerCopied Then ' Copy the header row if not already copied Count = Count + 1 Rng.Rows(1).Copy Set Paste_Range = Sheets(Main_Sheet).Cells(Range(Paste_Cell).Row + Count, Range(Paste_Cell).Column).Resize(1, Rng.Columns.Count) Paste_Range.PasteSpecial Paste:=xlPasteAll headerCopied = True ' Mark that the header has been copied End If Count = Count + 1 Rng.Rows(i).Copy Set Paste_Range = Sheets(Main_Sheet).Cells(Range(Paste_Cell).Row + Count, Range(Paste_Cell).Column).Resize(1, Rng.Columns.Count) If Copy_Format = True Then Paste_Range.PasteSpecial Paste:=xlPasteAll Else Paste_Range.PasteSpecial Paste:=xlPasteValues End If ' Highlight the matched word Call HighlightMatch(Paste_Range, Value1) End If Next j Next i Next S Application.CutCopyMode = False End Sub ' Function to highlight the searched word in the results Sub HighlightMatch(ByVal TargetRange As Range, ByVal SearchValue As String) Dim Cell As Range Dim StartPos As Integer Dim CellValue As String For Each Cell In TargetRange CellValue = Cell.Value ' No lowercase conversion StartPos = InStr(1, CellValue, SearchValue) If StartPos > 0 Then Cell.Characters(StartPos, Len(SearchValue)).Font.Bold = True Cell.Characters(StartPos, Len(SearchValue)).Font.Color = vbRed ' Highlight with red font End If Next Cell End Sub Download the Updated Excel File: www.exceldemy.com/wp-content/uploads/2024/09/Search-Box-for-Multiple-Sheets-and-Highlight-Matched-Words.xlsm Regards ExcelDemy
@@exceldemy2006 I noticed that you provided updated to correct if the cell was blank; however, I want to use the code you created without the Case Sensitive option and I'm having trouble correcting this code with the correction. Can you please assist on what would be different?
Hello @AliceBryant-n4m, You are most welcome. There is a way to clear the search results. Here’s how you can do it: 1. Define the specific worksheet and the range where the search results are displayed. 2. Clear the contents and formatting of that range. Copy-paste the following VBA code: Sub ClearSearchResults() Dim searchSheet As Worksheet Dim searchBox As Range Dim searchRange As Range ' Define the search sheet and search box location (adjust as needed) Set searchSheet = Sheets("VBA") Set searchBox = searchSheet.Range("B5") ' Define the range where the search results are displayed (adjust as needed) Set searchRange = searchSheet.Range("B9:F1000") ' Clear the contents and formatting of the search results searchRange.ClearContents searchRange.ClearFormats ' Clear the search term in the search box searchBox.Value = "" End Sub To add the Button: Go to the "Developer" tab. Click "Insert" and choose a button. Draw the button on the sheet. Assign the ClearSearchResults macro to the button. Here's the updated Excel File: www.exceldemy.com/wp-content/uploads/2024/07/Clear-Search-Box-for-Multiple-Sheets-1.xlsm Regards ExcelDemy
Dear, Thanks for your question! You want a sub-procedure that will not populate any result of the empty search box. Don't worry! We have modified the existing code based on your requirements. Please check the following: www.exceldemy.com/wp-content/uploads/2024/05/Output-of-using-a-sub-procedure-that-will-not-populate-any-result-of-the-empty-search-box.gif You can download the solution workbook: www.exceldemy.com/wp-content/uploads/2024/05/Coldsprouts-SOLVED.xlsm Excel VBA Sub-procedure: Sub SearchMultipleSheets() Main_Sheet = "VBA" Search_Cell = "B5" SearchType_Cell = "C5" Paste_Cell = "B9"
If Sheets(Main_Sheet).Range(Search_Cell).Value = "" Then Exit Sub End If
If Sheets(Main_Sheet).Range(SearchType_Cell).Value = "Case-Sensitive" Then Case_Sensitive = True ElseIf Sheets(Main_Sheet).Range(SearchType_Cell).Value = "Case-Insensitive" Then Case_Sensitive = False Else MsgBox ("Choose a Search Type.") Exit Sub End If
For S = LBound(Searched_Sheets) To UBound(Searched_Sheets) Set Rng = Sheets(Searched_Sheets(S)).Range(Searched_Ranges(S)) For i = 1 To Rng.Rows.Count For j = 1 To Rng.Columns.Count Value2 = Rng.Cells(i, j).Value If PartialMatch(Value1, Value2, Case_Sensitive) = True Then Count = Count + 1 Rng.Rows(i).Copy Set Paste_Range = Sheets(Main_Sheet).Cells(Range(Paste_Cell).Row + Count, Range(Paste_Cell).Column) If Copy_Format = True Then Paste_Range.PasteSpecial Paste:=xlPasteAll Else Paste_Range.PasteSpecial Paste:=xlPasteValues End If End If Next j Next i Next S
Application.CutCopyMode = False End Sub Function PartialMatch(Value1, Value2, Case_Sensitive) Matched = False
For i = 1 To Len(Value2) If Case_Sensitive = True Then If Mid(Value2, i, Len(Value1)) = Value1 Then Matched = True Exit For End If Else If Mid(LCase(Value2), i, Len(Value1)) = LCase(Value1) Then Matched = True Exit For End If End If Next i
Hello @user-gr6fl1mk2p, Sorry for the inconvenience. Please check out our updated article you will get the same code there : www.exceldemy.com/create-a-search-box-in-excel-for-multiple-sheets/#2_Create_a_Search_Box_in_Excel_for_Multiple_Sheets_with_VBA Also, you can download our updated Excel File. Thanks for watching our videos. Please stay connected with us. Regards ExcelDemy
Hi and thank you for this video. I am not computer savvy so I am racking my brain with this portion of the code: For i = 1 To Len(Value2) I copied the code from your embedded link but it keeps stopping at that line. Do you have any advice? Thanks
@@michaelwinsor511 Dear, Thanks for your kind words. The provided code is working perfectly on our end. You have copied the code from the link, but it stops in a particular line. Providing an ultimate solution without glancing at your dataset and being remote is difficult. So, we recommend that you share your problem within the ExcelDemy Forum. Here, you can also share your workbook and other necessary documents. ExcelDemy Forum: exceldemy.com/forum/
@@exceldemy2006 I am having this same issue as @michaelwinsor511 with the Error 13 for the line "For i = 1 To Len(Value2)" I've dug through your post on the website and a few other sites for "Error 13" but still can't see how the error would populate through the code. I've created a forum with the link provided above, so hopefully we can get the solution posted for others out there who may have this problem later.
@@brandychapman9375 Dear, Thanks for sharing your problem! Error 13 Type Mismatch in VBA typically occurs when you try to operate on incompatible data types. The Value2 variable contains cell values when looping through and comparing with Value1. Some of your values seem to contain errors, so it is impossible to use the Len function with this value. So, to avoid this type of situation, you can use IsError to check whether the cells contain any errors. If not, operate; otherwise, do nothing.
Hello @alpaynamazi, You are most welcome. We updated the VBA code: 1. To remove case sensitive option from the search result. 2. To Highlight the searched word. 3. To add headers from different sheets if match data is found. VBA Code: Sub SearchMultipleSheets_Updated() Main_Sheet = "VBA" Search_Cell = "B5" Paste_Cell = "B9" Searched_Sheets = Array("Dataset 1", "Dataset 2") Searched_Ranges = Array("B5:F23", "B5:F23") Copy_Format = True Last_Row = Sheets(Main_Sheet).Range(Paste_Cell).End(xlDown).Row Last_Column = Sheets(Main_Sheet).Range(Paste_Cell).End(xlToRight).Column Set Used_Range = Sheets(Main_Sheet).Range(Cells(Range(Paste_Cell).Row, Range(Paste_Cell).Column), Cells(Last_Row, Last_Column)) Used_Range.ClearContents Used_Range.ClearFormats Value1 = Sheets(Main_Sheet).Range(Search_Cell).Value ' No lowercase conversion Count = -1 For S = LBound(Searched_Sheets) To UBound(Searched_Sheets) Set Rng = Sheets(Searched_Sheets(S)).Range(Searched_Ranges(S)) Dim headerCopied As Boolean headerCopied = False ' To keep track if the header has been copied ' Start searching the range For i = 2 To Rng.Rows.Count ' Start from 2 to skip the header row For j = 1 To Rng.Columns.Count Value2 = Rng.Cells(i, j).Value If InStr(1, Value2, Value1) > 0 Then ' Check for match If Not headerCopied Then ' Copy the header row if not already copied Count = Count + 1 Rng.Rows(1).Copy Set Paste_Range = Sheets(Main_Sheet).Cells(Range(Paste_Cell).Row + Count, Range(Paste_Cell).Column).Resize(1, Rng.Columns.Count) Paste_Range.PasteSpecial Paste:=xlPasteAll headerCopied = True ' Mark that the header has been copied End If Count = Count + 1 Rng.Rows(i).Copy Set Paste_Range = Sheets(Main_Sheet).Cells(Range(Paste_Cell).Row + Count, Range(Paste_Cell).Column).Resize(1, Rng.Columns.Count) If Copy_Format = True Then Paste_Range.PasteSpecial Paste:=xlPasteAll Else Paste_Range.PasteSpecial Paste:=xlPasteValues End If ' Highlight the matched word Call HighlightMatch(Paste_Range, Value1) End If Next j Next i Next S Application.CutCopyMode = False End Sub ' Function to highlight the searched word in the results Sub HighlightMatch(ByVal TargetRange As Range, ByVal SearchValue As String) Dim Cell As Range Dim StartPos As Integer Dim CellValue As String For Each Cell In TargetRange CellValue = Cell.Value ' No lowercase conversion StartPos = InStr(1, CellValue, SearchValue) If StartPos > 0 Then Cell.Characters(StartPos, Len(SearchValue)).Font.Bold = True Cell.Characters(StartPos, Len(SearchValue)).Font.Color = vbRed ' Highlight with red font End If Next Cell End Sub Download the Updated Excel File: www.exceldemy.com/wp-content/uploads/2024/09/Search-Box-for-Multiple-Sheets-and-Highlight-Matched-Words.xlsm Regards ExcelDemy
@@exceldemy2006 Thank you very much for such a detailed answer. I will certainly try the first variant, because with the second one there is a very high chance of making a mistake in listing so many names or skipping one.
Hello @DonValentine, Thank you for your feedback! Excel sometimes flags files as a security risk if they contain macros or VBA, even if they are safe. This is a standard warning, not an indication of any issues with the file. We assure you that our workbook is secure and only includes the necessary functionalities to enhance your experience. If you prefer, you can adjust your Excel settings to avoid seeing these notifications for trusted files. Or you can copy the code from our article in your own workbook. The article link is given in the description box. Regards ExcelDemy
Thanks for your great tutorial. How can I remove Case Sensitive option and just type words and search? (Capitalization is not used in my language writing). Also how can I add the desired heading of various sheets to the results? (Headings vary in my worksheets)
Hello @alpaynamazi,
You are most welcome. We updated the VBA code:
1. To remove case sensitive option from the search result.
2. To Highlight the searched word.
3. To add headers from different sheets if match data is found.
VBA Code:
Sub SearchMultipleSheets_Updated()
Main_Sheet = "VBA"
Search_Cell = "B5"
Paste_Cell = "B9"
Searched_Sheets = Array("Dataset 1", "Dataset 2")
Searched_Ranges = Array("B5:F23", "B5:F23")
Copy_Format = True
Last_Row = Sheets(Main_Sheet).Range(Paste_Cell).End(xlDown).Row
Last_Column = Sheets(Main_Sheet).Range(Paste_Cell).End(xlToRight).Column
Set Used_Range = Sheets(Main_Sheet).Range(Cells(Range(Paste_Cell).Row, Range(Paste_Cell).Column), Cells(Last_Row, Last_Column))
Used_Range.ClearContents
Used_Range.ClearFormats
Value1 = Sheets(Main_Sheet).Range(Search_Cell).Value ' No lowercase conversion
Count = -1
For S = LBound(Searched_Sheets) To UBound(Searched_Sheets)
Set Rng = Sheets(Searched_Sheets(S)).Range(Searched_Ranges(S))
Dim headerCopied As Boolean
headerCopied = False ' To keep track if the header has been copied
' Start searching the range
For i = 2 To Rng.Rows.Count ' Start from 2 to skip the header row
For j = 1 To Rng.Columns.Count
Value2 = Rng.Cells(i, j).Value
If InStr(1, Value2, Value1) > 0 Then ' Check for match
If Not headerCopied Then
' Copy the header row if not already copied
Count = Count + 1
Rng.Rows(1).Copy
Set Paste_Range = Sheets(Main_Sheet).Cells(Range(Paste_Cell).Row + Count, Range(Paste_Cell).Column).Resize(1, Rng.Columns.Count)
Paste_Range.PasteSpecial Paste:=xlPasteAll
headerCopied = True ' Mark that the header has been copied
End If
Count = Count + 1
Rng.Rows(i).Copy
Set Paste_Range = Sheets(Main_Sheet).Cells(Range(Paste_Cell).Row + Count, Range(Paste_Cell).Column).Resize(1, Rng.Columns.Count)
If Copy_Format = True Then
Paste_Range.PasteSpecial Paste:=xlPasteAll
Else
Paste_Range.PasteSpecial Paste:=xlPasteValues
End If
' Highlight the matched word
Call HighlightMatch(Paste_Range, Value1)
End If
Next j
Next i
Next S
Application.CutCopyMode = False
End Sub
' Function to highlight the searched word in the results
Sub HighlightMatch(ByVal TargetRange As Range, ByVal SearchValue As String)
Dim Cell As Range
Dim StartPos As Integer
Dim CellValue As String
For Each Cell In TargetRange
CellValue = Cell.Value ' No lowercase conversion
StartPos = InStr(1, CellValue, SearchValue)
If StartPos > 0 Then
Cell.Characters(StartPos, Len(SearchValue)).Font.Bold = True
Cell.Characters(StartPos, Len(SearchValue)).Font.Color = vbRed ' Highlight with red font
End If
Next Cell
End Sub
Download the Updated Excel File:
www.exceldemy.com/wp-content/uploads/2024/09/Search-Box-for-Multiple-Sheets-and-Highlight-Matched-Words.xlsm
Regards
ExcelDemy
@@exceldemy2006 I noticed that you provided updated to correct if the cell was blank; however, I want to use the code you created without the Case Sensitive option and I'm having trouble correcting this code with the correction. Can you please assist on what would be different?
Thanks for the helpful video! Is there a way to clear the search results? Would it be a separate button? Or could the code be updated?
Hello @AliceBryant-n4m,
You are most welcome. There is a way to clear the search results. Here’s how you can do it:
1. Define the specific worksheet and the range where the search results are displayed.
2. Clear the contents and formatting of that range.
Copy-paste the following VBA code:
Sub ClearSearchResults()
Dim searchSheet As Worksheet
Dim searchBox As Range
Dim searchRange As Range
' Define the search sheet and search box location (adjust as needed)
Set searchSheet = Sheets("VBA")
Set searchBox = searchSheet.Range("B5")
' Define the range where the search results are displayed (adjust as needed)
Set searchRange = searchSheet.Range("B9:F1000")
' Clear the contents and formatting of the search results
searchRange.ClearContents
searchRange.ClearFormats
' Clear the search term in the search box
searchBox.Value = ""
End Sub
To add the Button:
Go to the "Developer" tab.
Click "Insert" and choose a button.
Draw the button on the sheet.
Assign the ClearSearchResults macro to the button.
Here's the updated Excel File:
www.exceldemy.com/wp-content/uploads/2024/07/Clear-Search-Box-for-Multiple-Sheets-1.xlsm
Regards
ExcelDemy
@@exceldemy2006 Amazing! Thanks so much :)
@AliceBryant-n4m You are most welcome. Thanks for your appreciation, it means a lot to us. Keep learning Excel with ExcelDemy.
hi! how can i make sure the macro does not run if search box is blank?
Dear, Thanks for your question! You want a sub-procedure that will not populate any result of the empty search box. Don't worry! We have modified the existing code based on your requirements. Please check the following: www.exceldemy.com/wp-content/uploads/2024/05/Output-of-using-a-sub-procedure-that-will-not-populate-any-result-of-the-empty-search-box.gif
You can download the solution workbook: www.exceldemy.com/wp-content/uploads/2024/05/Coldsprouts-SOLVED.xlsm
Excel VBA Sub-procedure:
Sub SearchMultipleSheets()
Main_Sheet = "VBA"
Search_Cell = "B5"
SearchType_Cell = "C5"
Paste_Cell = "B9"
Searched_Sheets = Array("Dataset 1", "Dataset 2")
Searched_Ranges = Array("B5:F23", "B5:F23")
Copy_Format = True
Last_Row = Sheets(Main_Sheet).Range(Paste_Cell).End(xlDown).Row
Last_Column = Sheets(Main_Sheet).Range(Paste_Cell).End(xlToRight).Column
Set Used_Range = Sheets(Main_Sheet).Range(Cells(Range(Paste_Cell).Row, Range(Paste_Cell).Column), Cells(Last_Row, Last_Column))
Used_Range.ClearContents
Used_Range.ClearFormats
Value1 = Sheets(Main_Sheet).Range(Search_Cell).Value
Count = -1
If Sheets(Main_Sheet).Range(Search_Cell).Value = "" Then
Exit Sub
End If
If Sheets(Main_Sheet).Range(SearchType_Cell).Value = "Case-Sensitive" Then
Case_Sensitive = True
ElseIf Sheets(Main_Sheet).Range(SearchType_Cell).Value = "Case-Insensitive" Then
Case_Sensitive = False
Else
MsgBox ("Choose a Search Type.")
Exit Sub
End If
For S = LBound(Searched_Sheets) To UBound(Searched_Sheets)
Set Rng = Sheets(Searched_Sheets(S)).Range(Searched_Ranges(S))
For i = 1 To Rng.Rows.Count
For j = 1 To Rng.Columns.Count
Value2 = Rng.Cells(i, j).Value
If PartialMatch(Value1, Value2, Case_Sensitive) = True Then
Count = Count + 1
Rng.Rows(i).Copy
Set Paste_Range = Sheets(Main_Sheet).Cells(Range(Paste_Cell).Row + Count, Range(Paste_Cell).Column)
If Copy_Format = True Then
Paste_Range.PasteSpecial Paste:=xlPasteAll
Else
Paste_Range.PasteSpecial Paste:=xlPasteValues
End If
End If
Next j
Next i
Next S
Application.CutCopyMode = False
End Sub
Function PartialMatch(Value1, Value2, Case_Sensitive)
Matched = False
For i = 1 To Len(Value2)
If Case_Sensitive = True Then
If Mid(Value2, i, Len(Value1)) = Value1 Then
Matched = True
Exit For
End If
Else
If Mid(LCase(Value2), i, Len(Value1)) = LCase(Value1) Then
Matched = True
Exit For
End If
End If
Next i
PartialMatch = Matched
End Function
The code in the article does not match up with the code in the video, so I cant get this to work
Hello @user-gr6fl1mk2p,
Sorry for the inconvenience. Please check out our updated article you will get the same code there :
www.exceldemy.com/create-a-search-box-in-excel-for-multiple-sheets/#2_Create_a_Search_Box_in_Excel_for_Multiple_Sheets_with_VBA
Also, you can download our updated Excel File.
Thanks for watching our videos. Please stay connected with us.
Regards
ExcelDemy
Hi and thank you for this video. I am not computer savvy so I am racking my brain with this portion of the code:
For i = 1 To Len(Value2)
I copied the code from your embedded link but it keeps stopping at that line. Do you have any advice? Thanks
@@michaelwinsor511 Dear, Thanks for your kind words.
The provided code is working perfectly on our end. You have copied the code from the link, but it stops in a particular line. Providing an ultimate solution without glancing at your dataset and being remote is difficult.
So, we recommend that you share your problem within the ExcelDemy Forum. Here, you can also share your workbook and other necessary documents.
ExcelDemy Forum: exceldemy.com/forum/
@@exceldemy2006 I am having this same issue as @michaelwinsor511 with the Error 13 for the line "For i = 1 To Len(Value2)" I've dug through your post on the website and a few other sites for "Error 13" but still can't see how the error would populate through the code. I've created a forum with the link provided above, so hopefully we can get the solution posted for others out there who may have this problem later.
@@brandychapman9375 Dear, Thanks for sharing your problem!
Error 13 Type Mismatch in VBA typically occurs when you try to operate on incompatible data types. The Value2 variable contains cell values when looping through and comparing with Value1. Some of your values seem to contain errors, so it is impossible to use the Len function with this value. So, to avoid this type of situation, you can use IsError to check whether the cells contain any errors. If not, operate; otherwise, do nothing.
Also how can I highlight the searched word in the results?
Hello @alpaynamazi,
You are most welcome. We updated the VBA code:
1. To remove case sensitive option from the search result.
2. To Highlight the searched word.
3. To add headers from different sheets if match data is found.
VBA Code:
Sub SearchMultipleSheets_Updated()
Main_Sheet = "VBA"
Search_Cell = "B5"
Paste_Cell = "B9"
Searched_Sheets = Array("Dataset 1", "Dataset 2")
Searched_Ranges = Array("B5:F23", "B5:F23")
Copy_Format = True
Last_Row = Sheets(Main_Sheet).Range(Paste_Cell).End(xlDown).Row
Last_Column = Sheets(Main_Sheet).Range(Paste_Cell).End(xlToRight).Column
Set Used_Range = Sheets(Main_Sheet).Range(Cells(Range(Paste_Cell).Row, Range(Paste_Cell).Column), Cells(Last_Row, Last_Column))
Used_Range.ClearContents
Used_Range.ClearFormats
Value1 = Sheets(Main_Sheet).Range(Search_Cell).Value ' No lowercase conversion
Count = -1
For S = LBound(Searched_Sheets) To UBound(Searched_Sheets)
Set Rng = Sheets(Searched_Sheets(S)).Range(Searched_Ranges(S))
Dim headerCopied As Boolean
headerCopied = False ' To keep track if the header has been copied
' Start searching the range
For i = 2 To Rng.Rows.Count ' Start from 2 to skip the header row
For j = 1 To Rng.Columns.Count
Value2 = Rng.Cells(i, j).Value
If InStr(1, Value2, Value1) > 0 Then ' Check for match
If Not headerCopied Then
' Copy the header row if not already copied
Count = Count + 1
Rng.Rows(1).Copy
Set Paste_Range = Sheets(Main_Sheet).Cells(Range(Paste_Cell).Row + Count, Range(Paste_Cell).Column).Resize(1, Rng.Columns.Count)
Paste_Range.PasteSpecial Paste:=xlPasteAll
headerCopied = True ' Mark that the header has been copied
End If
Count = Count + 1
Rng.Rows(i).Copy
Set Paste_Range = Sheets(Main_Sheet).Cells(Range(Paste_Cell).Row + Count, Range(Paste_Cell).Column).Resize(1, Rng.Columns.Count)
If Copy_Format = True Then
Paste_Range.PasteSpecial Paste:=xlPasteAll
Else
Paste_Range.PasteSpecial Paste:=xlPasteValues
End If
' Highlight the matched word
Call HighlightMatch(Paste_Range, Value1)
End If
Next j
Next i
Next S
Application.CutCopyMode = False
End Sub
' Function to highlight the searched word in the results
Sub HighlightMatch(ByVal TargetRange As Range, ByVal SearchValue As String)
Dim Cell As Range
Dim StartPos As Integer
Dim CellValue As String
For Each Cell In TargetRange
CellValue = Cell.Value ' No lowercase conversion
StartPos = InStr(1, CellValue, SearchValue)
If StartPos > 0 Then
Cell.Characters(StartPos, Len(SearchValue)).Font.Bold = True
Cell.Characters(StartPos, Len(SearchValue)).Font.Color = vbRed ' Highlight with red font
End If
Next Cell
End Sub
Download the Updated Excel File:
www.exceldemy.com/wp-content/uploads/2024/09/Search-Box-for-Multiple-Sheets-and-Highlight-Matched-Words.xlsm
Regards
ExcelDemy
@@exceldemy2006 You're the best
Dear @alpaynamazi,
You are most welcome. Your appreciation means a lot to us. Keep learning Excel with ExcelDemy!
Regards
ExcelDemy
What if I have over 100 worksheets?
Hello @branimirperkovic,
If you have over 100 worksheets either you need to mention them in the Searched_Sheets and Searched_Ranges or you can use this updated code. Here the code will loop through all the available sheets in the workbook.
Sub SearchAllSheets()
Dim ws As Worksheet
Dim SearchTerm As String
Dim Cell As Range
Dim FirstAddress As String
' The search term is taken from a specific cell, e.g., B1 on the "VBA" sheet
SearchTerm = Sheets("VBA").Range("B1").Value
If SearchTerm = "" Then
MsgBox "Please enter a search term in cell B1 of the VBA sheet."
Exit Sub
End If
For Each ws In ThisWorkbook.Worksheets
ws.Cells.Interior.ColorIndex = xlNone
With ws.UsedRange
Set Cell = .Find(SearchTerm, LookIn:=xlValues, LookAt:=xlPart)
If Not Cell Is Nothing Then
FirstAddress = Cell.Address
Do
Cell.Interior.Color = vbYellow
Set Cell = .FindNext(Cell)
Loop While Not Cell Is Nothing And Cell.Address FirstAddress
End If
End With
Next ws
MsgBox "Search Complete!"
End Sub
But if you wish to use the code used in the video you need to do the following adjustments in the searched sheets and ranges.
Searched_Sheets = Array("Dataset 1", "Dataset 2", "Dataset 3", "Dataset 4", "Dataset 5", _
"Dataset 6", "Dataset 7", "Dataset 8", "Dataset 9", "Dataset 10", _
"Dataset 11", "Dataset 12", "Dataset 13", "Dataset 14", "Dataset 15", _
"Dataset 16", "Dataset 17", "Dataset 18", "Dataset 19", "Dataset 20", _
"Dataset 21", "Dataset 22", "Dataset 23", "Dataset 24", "Dataset 25", _
"Dataset 26", "Dataset 27", "Dataset 28", "Dataset 29", "Dataset 30", _
"Dataset 31", "Dataset 32", "Dataset 33", "Dataset 34", "Dataset 35", _
"Dataset 36", "Dataset 37", "Dataset 38", "Dataset 39", "Dataset 40", _
"Dataset 41", "Dataset 42", "Dataset 43", "Dataset 44", "Dataset 45", _
"Dataset 46", "Dataset 47", "Dataset 48", "Dataset 49", "Dataset 50", _
"Dataset 51", "Dataset 52", "Dataset 53", "Dataset 54", "Dataset 55", _
"Dataset 56", "Dataset 57", "Dataset 58", "Dataset 59", "Dataset 60", _
"Dataset 61", "Dataset 62", "Dataset 63", "Dataset 64", "Dataset 65", _
"Dataset 66", "Dataset 67", "Dataset 68", "Dataset 69", "Dataset 70", _
"Dataset 71", "Dataset 72", "Dataset 73", "Dataset 74", "Dataset 75", _
"Dataset 76", "Dataset 77", "Dataset 78", "Dataset 79", "Dataset 80", _
"Dataset 81", "Dataset 82", "Dataset 83", "Dataset 84", "Dataset 85", _
"Dataset 86", "Dataset 87", "Dataset 88", "Dataset 89", "Dataset 90", _
"Dataset 91", "Dataset 92", "Dataset 93", "Dataset 94", "Dataset 95", _
"Dataset 96", "Dataset 97", "Dataset 98", "Dataset 99", "Dataset 100")
Searched_Ranges = Array("B5:F23", "B5:F23", "B5:F23", "B5:F23", "B5:F23", _
"B5:F23", "B5:F23", "B5:F23", "B5:F23", "B5:F23", _
"B5:F23", "B5:F23", "B5:F23", "B5:F23", "B5:F23", _
"B5:F23", "B5:F23", "B5:F23", "B5:F23", "B5:F23", _
"B5:F23", "B5:F23", "B5:F23", "B5:F23", "B5:F23", _
"B5:F23", "B5:F23", "B5:F23", "B5:F23", "B5:F23", _
"B5:F23", "B5:F23", "B5:F23", "B5:F23", "B5:F23", _
"B5:F23", "B5:F23", "B5:F23", "B5:F23", "B5:F23", _
"B5:F23", "B5:F23", "B5:F23", "B5:F23", "B5:F23", _
"B5:F23", "B5:F23", "B5:F23", "B5:F23", "B5:F23", _
"B5:F23", "B5:F23", "B5:F23", "B5:F23", "B5:F23", _
"B5:F23", "B5:F23", "B5:F23", "B5:F23", "B5:F23", _
"B5:F23", "B5:F23", "B5:F23", "B5:F23", "B5:F23", _
"B5:F23", "B5:F23", "B5:F23", "B5:F23", "B5:F23", _
"B5:F23", "B5:F23", "B5:F23", "B5:F23", "B5:F23", _
"B5:F23", "B5:F23", "B5:F23", "B5:F23", "B5:F23", _
"B5:F23", "B5:F23", "B5:F23", "B5:F23", "B5:F23", _
"B5:F23", "B5:F23", "B5:F23", "B5:F23", "B5:F23", _
"B5:F23", "B5:F23", "B5:F23", "B5:F23", "B5:F23", _
"B5:F23", "B5:F23", "B5:F23", "B5:F23", "B5:F23")
Regards
ExcelDemy
@@exceldemy2006 Thank you very much for such a detailed answer. I will certainly try the first variant, because with the second one there is a very high chance of making a mistake in listing so many names or skipping one.
You are most welcome @branimirperkovic.
Nice try, when I download your sample workbook, it says there is a security risk. Deleted it immediately.
Hello @DonValentine,
Thank you for your feedback! Excel sometimes flags files as a security risk if they contain macros or VBA, even if they are safe. This is a standard warning, not an indication of any issues with the file. We assure you that our workbook is secure and only includes the necessary functionalities to enhance your experience.
If you prefer, you can adjust your Excel settings to avoid seeing these notifications for trusted files. Or you can copy the code from our article in your own workbook. The article link is given in the description box.
Regards
ExcelDemy