Extraction of IP Addresses from an excel sheet along with their descriptions and writing them to another excel sheet.

[Purple_Squirrel]

Hi,
I have an excel sheet full of IP Addresses along with their descriptions in adjacent cells like 192.168.1.1 ABC, 192.168.1.2 XYZ.....etc what I am trying to do is to extract all of these IP Addresses along with their descriptions from a worksheet and write them to another worksheet in adjacent columns like:
192.168.1.1 ABC
192.168.1.2 XYZ and so on.
I apologize for the fact that I am not good at VB Script and not much idea how to accomplish this. I have have attempted to use the following VB Script gotten from one of the threads:

Sub blah()
'Set MasterSpreadsheet = ("D:\\Test.xls")
For Each sht In ThisWorkbook.Sheets
If Application.CountA(sht.Cells) > 0 Then
i = 1
ReDim Results(1 To 1)
With sht.Cells
Set c = .Find(what:="*?.?*.?*.?*", Lookat:=xlPart, LookIn:=xlFormulas)
If Not c Is Nothing Then
firstAddress = c.Address
Do
zzz = ExtractIPs(c.Value)
If Len(zzz) > 0 Then
ReDim Preserve Results(1 To i)
Results(i) = zzz
i = i + 1
' Application.Goto c
' MsgBox "here! " & vbLf & zzz
End If
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
.Cells(.Rows.Count, "AD").End(xlUp).Offset(1).Resize(UBound(Results)) = Application.Transpose(Results)
' With MasterSpreadsheet
' Set Destn = .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Resize(UBound(Results))
' Destn = Application.Transpose(Results)
' Destn.Offset(, 1) = "from sheet " & sht.Name
' End With 'MasterSpreadsheet
End With 'sht.Cells
End If
Next sht
End Sub


Function ExtractIPs(s As String)
With CreateObject("VBScript.RegExp")
.Pattern = "[\s\S]*?(\d{1,3}(\.\d{1,3}){3})|[\s\S]*"
.Global = True
ExtractIPs = Replace(Trim(.Replace(s, " $1")), " ", ", ")
End With
End Function


I would be extremely appreciative if someone would help me with what I am trying to do. Thank you.

 

[Rijnsent]

Hi Purple,
your code seems to extract the IP address from text strings, but in your description it seems like the IP addresses are already in separate cells? What does your input sheet look like?
A2: 192.168.1.1
B2: ABC
A3: 192.168.1.2
B3: XYZ
etc.? Or something like: A2: "192.168.1.1 ABC" , B2: "192.168.1.2 XYZ" etc?
Koen

 

[pgc01]

Hi Purple,
your code seems to extract the IP address from text strings, but in your description it seems like the IP addresses are already in separate cells? What does your input sheet look like?
A2: 192.168.1.1
B2: ABC
A3: 192.168.1.2
B3: XYZ
etc.? Or something like: A2: "192.168.1.1 ABC" , B2: "192.168.1.2 XYZ" etc?
Koen

or, just in 1 cell something like

192.168.1.1 ABC, 192.168.1.2 XYZ, 192.168.1.3 OK, 192.168.1.4 TEST


?

 

[Purple_Squirrel]

Dear Koen,
thank you for your response. The IP Addresses are indeed in separate cells like A2(Description); B2(IP Address) however the trouble is they are not all sequentially arranged ( Column A doesn't contain all the descriptions nor Column B contains all the IP Addresses). They are arranged more or less like A2(Description); B2 (IP Address) and E3(Description); F3 (IP Address) so what I am trying to do is to write code that will look for the IP Address, extract it and will also extract the text that its left cell contains and writes then both to another worksheet in a sequential manner. For Instance if the situation was: G

2(Description such as ABC); F2 (IP Address, 192.168.1.0) then the code will sniff out F2, extract its contents and will also 'look left' to its adjacent cell (G2) also extract its contents and write them to another worksheet in

A2(ABC); B2 (192.168.1.0). My objective is to get all these IP Addresses along with their descriptions arranged into a single column and row. I would appreciate your help/suggestions on this one.
Regards,
Purple​

​

 

[DataBlake]

would it be possible to create a filter of IP addresses (since IP's follow number conventions) and then transpose the filtered results?
use a filter that contains "192" or possibly "is greater than 1" to filter anything text based out in desired columns etc
then just transpose the remaining results using an array formula or VBA

 

[Rijnsent]

Hi Purple,
your code almost does that. I added 1 tweak to add the description (and check the cell left&right of the found IP). Is this what you're looking for?
Koen

Sub blah()

'Set MasterSpreadsheet = ("D:\\Test.xls")
For Each sht In ThisWorkbook.Sheets
    If Application.CountA(sht.Cells) > 0 Then
        i = 1
        ReDim Results(1 To 2, 1 To 1)
        With sht.Cells
            Set c = .Find(what:="*?.?*.?*.?*", Lookat:=xlPart, LookIn:=xlFormulas)
            If Not c Is Nothing Then
                firstAddress = c.Address
                Do
                    zzz = ExtractIPs(c.Value)
                    If Len(zzz) > 0 Then
                        ReDim Preserve Results(1 To 2, 1 To i)
                        If c.Offset(0, 1).Value <> "" Then Results(1, i) = c.Offset(0, 1).Value
                        If c.Offset(0, -1).Value <> "" Then Results(1, i) = c.Offset(0, -1).Value
                        Results(2, i) = zzz
                        i = i + 1
                        ' Application.Goto c
                        ' MsgBox "here! " & vbLf & zzz
                    End If
                    Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> firstAddress
            End If
            .Cells(.Rows.Count, "AD").End(xlUp).Offset(1).Resize(UBound(Results, 2), UBound(Results, 1)) = Application.Transpose(Results)
            ' With MasterSpreadsheet
            ' Set Destn = .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Resize(UBound(Results))
            ' Destn = Application.Transpose(Results)
            ' Destn.Offset(, 1) = "from sheet " & sht.Name
            ' End With 'MasterSpreadsheet
        End With 'sht.Cells
    End If
Next sht

End Sub


Function ExtractIPs(s As String)
With CreateObject("VBScript.RegExp")
    .Pattern = "[\s\S]*?(\d{1,3}(\.\d{1,3}){3})|[\s\S]*"
    .Global = True
    ExtractIPs = Replace(Trim(.Replace(s, " $1")), " ", ", ")
End With
End Function

 

[Purple_Squirrel]

Hi Purple,
your code almost does that. I added 1 tweak to add the description (and check the cell left&right of the found IP). Is this what you're looking for?
Koen

Sub blah()

'Set MasterSpreadsheet = ("D:\\Test.xls")
For Each sht In ThisWorkbook.Sheets
    If Application.CountA(sht.Cells) > 0 Then
        i = 1
        ReDim Results(1 To 2, 1 To 1)
        With sht.Cells
            Set c = .Find(what:="*?.?*.?*.?*", Lookat:=xlPart, LookIn:=xlFormulas)
            If Not c Is Nothing Then
                firstAddress = c.Address
                Do
                    zzz = ExtractIPs(c.Value)
                    If Len(zzz) > 0 Then
                        ReDim Preserve Results(1 To 2, 1 To i)
                        If c.Offset(0, 1).Value <> "" Then Results(1, i) = c.Offset(0, 1).Value
                        If c.Offset(0, -1).Value <> "" Then Results(1, i) = c.Offset(0, -1).Value
                        Results(2, i) = zzz
                        i = i + 1
                        ' Application.Goto c
                        ' MsgBox "here! " & vbLf & zzz
                    End If
                    Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> firstAddress
            End If
            .Cells(.Rows.Count, "AD").End(xlUp).Offset(1).Resize(UBound(Results, 2), UBound(Results, 1)) = Application.Transpose(Results)
            ' With MasterSpreadsheet
            ' Set Destn = .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Resize(UBound(Results))
            ' Destn = Application.Transpose(Results)
            ' Destn.Offset(, 1) = "from sheet " & sht.Name
            ' End With 'MasterSpreadsheet
        End With 'sht.Cells
    End If
Next sht

End Sub


Function ExtractIPs(s As String)
With CreateObject("VBScript.RegExp")
    .Pattern = "[\s\S]*?(\d{1,3}(\.\d{1,3}){3})|[\s\S]*"
    .Global = True
    ExtractIPs = Replace(Trim(.Replace(s, " $1")), " ", ", ")
End With
End Function

Dear Koen,
Wow! That's brilliant! Thank you so very much! This was exactly what I was struggling to do. Just one more thing, is there a way to filter out the IP Addresses that don't have a description? Such as
if the description is blank then the IP Address should not be extracted at all. Currently the code extracts the description irrespective of whether it is blank or contains information. Any suggestions/help would be greatly appreciated. Thanks again!
Regards,
Purple

 

[Purple_Squirrel]

Hi Koen,
I tweaked the code some more and I think this will do it:

Sub blah()


'Set MasterSpreadsheet = ("D:\\Test.xls")
For Each sht In ThisWorkbook.Sheets
If Application.CountA(sht.Cells) > 0 Then
i = 1
ReDim Results(1 To 2, 1 To 1)
With sht.Cells
Set c = .Find(what:="*?.?*.?*.?*", Lookat:=xlPart, LookIn:=xlFormulas)
If (Not c Is Nothing) Then
firstAddress = c.Address
Do
'If (IsEmpty(c.Offset(0, 1).Value) = True) Then
zzz = ExtractIPs(c.Value)
If Len(zzz) > 0 And (IsEmpty(c.Offset(0, 1).Value) = False) Then
ReDim Preserve Results(1 To 2, 1 To i)
If (c.Offset(0, 1).Value <> "") Then Results(1, i) = c.Offset(0, 1).Value
If c.Offset(0, -1).Value <> "" Then Results(1, i) = c.Offset(0, -1).Value
Results(2, i) = zzz
i = i + 1
' Application.Goto c
' MsgBox "here! " & vbLf & zzz
End If
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
.Cells(.Rows.Count, "AD").End(xlUp).Offset(1).Resize(UBound(Results, 2), UBound(Results, 1)) = Application.Transpose(Results)
' With MasterSpreadsheet
' Set Destn = .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Resize(UBound(Results))
' Destn = Application.Transpose(Results)
' Destn.Offset(, 1) = "from sheet " & sht.Name
' End With 'MasterSpreadsheet
End With 'sht.Cells
End If
Next sht


End Sub




Function ExtractIPs(s As String)
With CreateObject("VBScript.RegExp")
.Pattern = "[\s\S]*?(\d{1,3}(\.\d{1,3}){3})|[\s\S]*"
.Global = True
ExtractIPs = Replace(Trim(.Replace(s, " $1")), " ", ", ")
End With
End Function

what I am trying to do now is to sort the IP Addresses and their descriptions according to the value in the fourth octet in the ascending order something like 192.168.1.0 ABC; 192.168.1.1 XYZ and so on. Any ideas/suggestions on this one?
Regards,
Purple

 

[Purple_Squirrel]

Dear Koen,
No worries! I have figured it out. Thank you for your help/suggestions!
Regards,
Purple