Mark cells bold with matching partial charachters - excel

Question

I have a code that's not working yet.
It is supposed to open an input window where you can enter a text.
Then it should open an window where you can enter the range.
After both entries the whole workbook should be searched and the whole cell where the partial text is located should be marked bold.
If the cell contains more text than the one you are looking for, it should be marked bold.
Example in the cell there is the text:
"Export Area Asia"
If I only enter "Export Area" in the input window, the cell containing "Export Area Asia" should be marked completely bold.
Here is my code so far:
Sub Zelle_Fett_Wenn_best_Inhalt_Input_Box()
Dim Filtertext As String
Dim ws As Worksheet
Dim aRange As Range
On Error Resume Next
Set aRange = Application.InputBox(prompt:="Enter range", Type:=8)
If aRange Is Nothing Then
MsgBox "Operation Cancelled"
Else
aRange.Select
End If
Filtertext = InputBox("Enter Text")
For Each ws In Worksheets
ws.Select
x = ActiveSheet.UsedRange.Rows.Count
Rows.Select
If Cells.Value Like Filtertext Then
Selection.Font.Bold = True
Else
Selection.Font.Bold = False
End If
Next ws
End Sub
Maybe somebody would be so nice to correct it so that it works.
Thanks a lot and cheers
Tom

Answer 1

So as per my comment, I'd advise against using .Select or UsedRange. Instead get your last used row and column dynamically. Furthermore, you are missing wildcards in your Like operator plus you'd want to iterate over your whole Range object.
Next, I'd say you could skip iteration and either use conditional formatting OR use ReplaceFormat, for example:
Sub Test()
Dim lr As Long, lc As Long, rng As Range, ws As Worksheet, FilterText As String
FilterText = InputBox("Enter Text")
If FilterText = "" Then Exit Sub
For Each ws In ThisWorkbook.Worksheets
'Get last used row and column
lr = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
lc = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
'Set your range object
Set rng = ws.Range(ws.Cells(1, 1), ws.Cells(lr, lc))
'Set your ReplaceFormat
With Application.ReplaceFormat
.Clear
.Font.Bold = True
End With
'Replace formatting to cells with right criteria
rng.Font.Bold = False
rng.Replace What:="*" & FilterText & "*", Replacement:="", SearchFormat:=False, ReplaceFormat:=True
Next ws
End Sub
I left out aRange since I noticed you never even use it.