VBA to 'print' matched search results to new WS - vba

Question

I have some coding which loops through a list of policy numbers, and then searches through an entire workbook for a matching policy number, bolding any matches found in the original list. The coding works fine, however what I would like to do if possible, is to 'print' the address/cell location of the matching value. For example, if policy number 1 was located on sheet 3, cell a1, then this would be displayed on a new blank worksheet. I'm sure this can be done using dictionaries and the print.debug function, But I want to avoid using a dictionary if possible. Hope this makes sense!
Sub HighlightMatches()
Application.ScreenUpdating = True
Dim var As Variant, iSheet As Integer, iRow As Long, iRowL As Long,bln As Boolean
iRowL = Sheets(3).Cells(Rows.Count, "P").End(xlUp).row
For iRow = 1 To iRowL
If Not IsEmpty(Cells(iRow, 16)) Then
For iSheet = ActiveSheet.Index + 1 To Worksheets.Count
bln = False
var = Application.match(Cells(iRow, 16).Value, Worksheets(iSheet).Columns(16), 0)
If Not IsError(var) Then
bln = True
Exit For
End If
Next iSheet
End If
' The below would 'print' all matches and an offset value to a new Worksheet.
If bln = False Then
Cells(iRow, 16).Font.Bold = False
Else
Cells(iRow, 16).Font.Bold = True
End If
Next iRow
Application.ScreenUpdating = True
End Sub

Answer 1

This would do it:
Option Explicit
Sub HighlightMatches()
Dim OriginalWS As Worksheet, NewListWorksheet As Worksheet, ws As Worksheet
Dim Cel As Range, Rng As Range, rSearchCell As Range
Set OriginalWS = ActiveSheet
Set Rng = Columns("P:P").SpecialCells(xlCellTypeConstants, 23)
For Each Cel In Rng
For Each ws In ActiveWorkbook.Worksheets
If ws.Name <> OriginalWS.Name And ws.Name <> "Search List" Then
On Error Resume Next
Set rSearchCell = ws.Columns("P:P").Find(What:=Cel.Value, After:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
On Error GoTo 0
If Not rSearchCell Is Nothing Then
Cel.Font.Bold = True
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Search List"
On Error Resume Next
Set NewListWorksheet = ActiveSheet
On Error GoTo 0
If Not NewListWorksheet Is Nothing Then
NewListWorksheet.Range("A" & NewListWorksheet.Range("A" & NewListWorksheet.Rows.Count).End(xlUp).Row + 1).Value = Cel.Value
Else
Set NewListWorksheet = Sheets.Add.Name = "Search List"
NewListWorksheet.Range("A1").Value = "Search results"
NewListWorksheet.Range("A1").Font.Bold = True
NewListWorksheet.Range("A2").Value = Cel.Value
End If
Else
Cel.Font.Bold = False
End If
End If
Set rSearchCell = Nothing 'Clear Cel
Next
Next
End Sub