Extract single IP address from a string

[IanPC]

Hello - I have a spreadsheet of URLs, some of which contain IP addresses and some don't. I'm struggling to write an excel formula that will identify the URLs with IP addresses in them, and extract that IP address into another cell. What formula would I paste down column B to achieve this?

URL (column A)	Desired output (column B)
http://sample.domain/the/eed/dhgg.html	[#Error of some kind]
http://10.22.88.11/eid/tedld/ed.html	10.22.88.11
http://242.25.23.7/ede/vkjd/tt.html	242.25.23.7
etc

<tbody>
</tbody>

Any help gratefully received. Many thanks.

 

[Peter_SSs]

Are they really your expected results for IP addresses?
For example:
3172.26.56.104
903172.16.106.29
000008239.240.0.182

 

[billtadz]

Are they really your expected results for IP addresses?
For example:
3172.26.56.104
903172.16.106.29
000008239.240.0.182

We can also ignore those.

 

[Peter_SSs]

We can also ignore those.

So you do not want 172.26.56.104 extracted in the first row then?

 

[billtadz]

I will make it simpler now.
Apologize for the confusion.

source	First IP	Second IP
Gwinnett (3a)_VIPR 172.26.56.104	172.26.56.104
Harmonic - 172.24.100.46 255.255.255.0	172.24.100.46	255.255.255.0
Imagine BMS 107.8.2.116	107.8.2.116
Imagine Encoder – 50.113.193.109	50.113.193.109
IMAGINE ENCODER - IMG-DLLATX-ENC04 - 24.174.45.215	24.174.45.215
Imagine Encoder TWC-MW-05 107.8.3.109	107.8.3.109
IMG_c7-01 (107.8.2.116)	107.8.2.116
IN-PS9K_03 172.16.106.29 0.0.0.255	172.16.106.29	0.0.0.255
IN-PS9K_05_SLDCMO 172.28.52.73	172.28.52.73
ION Encoder 172.21.34.13	172.21.34.13
ION-4 Encoder - 107.9.92.70	107.9.92.70
IVMS 184.152.127.53	184.152.127.53
IVMS 69.76.65.67	69.76.65.67

 

[Peter_SSs]

I will make it simpler now.
Apologize for the confusion.

Thanks, that is clearer.

I see that you have Excel 365 and am assuming that you have the new dynamic array functions (eg UNIQUE) that automatically 'spill' into required ranges. If that is so, this udf copied down a single column should produce the required results as the function in each row should spill any multiple IPs across that row.

Function IPs(s As String) As Variant
  Dim itm As Variant
  Dim tmp As String
  
  IPs = ""
  With CreateObject("VBScript.RegExp")
    .Global = True
    .Pattern = "((\d{1,3}\.){2,3}\d{1,3})"
    For Each itm In .Execute(s)
      tmp = tmp & " " & itm
    Next itm
  End With
  If Len(tmp) > 0 Then IPs = Split(Mid(tmp, 2))
End Function

Is it correct that you want nothing returned in the second last row here?

billtadz.xlsm
	A	B	C	D
1	source	First IP	Second IP
2	Gwinnett (3a)_VIPR 172.26.56.104	172.26.56.104
3	Harmonic - 172.24.100.46 255.255.255.0	172.24.100.46	255.255.255.0
4	Imagine BMS 107.8.2.116	107.8.2.116
5	Imagine Encoder – 50.113.193.109	50.113.193.109
6	IMAGINE ENCODER - IMG-DLLATX-ENC04 - 24.174.45.215	24.174.45.215
7	Imagine Encoder TWC-MW-05 107.8.3.109	107.8.3.109
8	IMG_c7-01 (107.8.2.116)	107.8.2.116
9
10	No IPs here
11	IN-PS9K_03 172.16.106.29 0.0.0.255	172.16.106.29	0.0.0.255
12	IN-PS9K_05_SLDCMO 172.28.52.73	172.28.52.73
13	ION Encoder 172.21.34.13	172.21.34.13
14	ION-4 Encoder - 107.9.92.70	107.9.92.70
15	IVMS 184.152.127.53	184.152.127.53
16	IVMS 69.76.65.67	69.76.65.67
17	IN-PS9K_03 172.16.106.29 0.0.0.255 ABC 125.125.125.125	172.16.106.29	0.0.0.255	125.125.125.125
18	ION-4 Encoder - 46.9
19	ION-4 Encoder - 46.9.2	46.9.2
Sheet1

Cell Formulas
Range	Formula
B2,B4:B10,B12:B16,B18:B19,B17:D17,B11:C11,B3:C3	B2	=IPs(A2)

 

[billtadz]

Sorry, Im using 2016 and it doesnt spread to Column C and D.

 

[billtadz]

second last row is correct.

 

[Peter_SSs]

Sorry, Im using 2016

OK, I see you have changed that in your profile now.

So, would you be looking for a user-defined function that gets copied down and across several columns or a straight macro that just populates the required cells?

 

[billtadz]

A straight macro is favourable.

 

[Peter_SSs]

A straight macro is favourable.

Try this with a copy of your data.

Sub Get_IPs()
  Dim RX As Object
  Dim a As Variant, b As Variant, itm As Variant
  Dim i As Long
  
  a = Range("A2", Range("A" & Rows.Count).End(xlUp)).Value
  ReDim b(1 To UBound(a), 1 To 1)
  Set RX = CreateObject("VBScript.RegExp")
  RX.Global = True
  RX.Pattern = "((\d{1,3}\.){2,3}\d{1,3})"
  For i = 1 To UBound(a)
    For Each itm In RX.Execute(a(i, 1))
      b(i, 1) = b(i, 1) & " " & itm
    Next itm
  Next i
  With Range("B2").Resize(UBound(b))
    .Value = b
    .TextToColumns DataType:=xlDelimited, Space:=True, Other:=False, FieldInfo:=Array(1, 9)
  End With
End Sub