VBA match on IP and write to cell not working - excel

Question

writing macro to extract IP out of many cells and buried in text. I need to find the IP and then copy each to a new blank cell.
I get the results "not matched". Please advise as I'm over thinking this.
To test I filled 40 cells with "this is a ip test 8.8.8.8 oh no"
Private Sub simpleRegex()
Dim strPattern As String: strPattern = "\b(?:[0-9]{1,3}\.){3}[0-9]{1,3}\b" 'find IP
Dim Match As Object
Dim matches As Object
Dim regex As Object
Set regex = CreateObject("VBScript.RegExp")
Dim strInput As String
Dim Myrange As Range
Set Myrange = ActiveSheet.Range("A1:A39") 'within this range
Dim i As Long, strMatches As String
i = 1 'row number where we start to write
For Each cell In Myrange
If strPattern <> "" Then
strInput = cell.Value
With regex
.Global = True
.MultiLine = True
.IgnoreCase = False
.Pattern = strPattern
End With
If regex.Test(strInput) Then 'if ip found do this
Set matches = regex.Execute(strInput)
strMatches = vbNullString
For Each Match In matches
'strMatches = strMatches 'collect all matches ip?
Worksheets("Sheet1").Range("U" & i).Value = strMatches 'write the matches into cell
i = i + 1
Next
Else
MsgBox ("Not matched")
End If
End If
Next
End Sub

Answer 1

This works for me (re-arranged the output a bit)
Private Sub simpleRegex()
Dim strPattern As String:
Dim Match As Object
Dim matches As Object
Dim strMatches As String
Dim regex As Object
Dim strInput As String
Dim Myrange As Range, cell As Range, cOut as Range
Set regex = CreateObject("VBScript.RegExp")
strPattern = "\b(?:[0-9]{1,3}\.){3}[0-9]{1,3}\b" 'find IP
With regex
.Global = True
.MultiLine = True
.IgnoreCase = False
.Pattern = strPattern
End With
Set cOut = ActiveWorkbook.Worksheets("Sheet2").Range("A1") 'start output here
Set Myrange = ActiveSheet.Range("A1:A39") 'within this range
For Each cell In Myrange
strInput = cell.Value
If Len(strInput) > 0 Then
If regex.Test(strInput) Then 'if ip found do this
Set matches = regex.Execute(strInput)
strMatches = vbNullString
For Each Match In matches
cOut.Value = Match.Value 'write the match into cell
Set cOut = cOut.Offset(1, 0)'next cell down
Next
Else
'cell.Offset(0, 1).Value = "No matches"
End If
End If
Next
End Sub