Excel IP Address Parse and Search

[birdman91]

Hello All,

I've been lurking through these forums in search of a result for my problem and could not find a complete solution. So I made an account to see if someone out there can help me out.

I have a word document that I get regularly that contains hundreds of IP address along with text in this general Format:

We are looking at these IP address 122.122.121.123 and 12.13.51.123 with special attention to the following:
A. 187.213.123.1
B. 232.123.54.012
C. etc
D. etc...

1. 124.123.123.123
2. 18.12.51.32
3. etc....

Right now I am copying and pasting the word document into excel and running the following

Sub removechar()
Dim rng as range
Dim workrng as range
on error resume next
xtitleid = "IPaddress"
set workrng = application.selection
set workrng = application.inputbox("range", xtitleid, working.address, type:=8)
For Each rng in workrng
     xout = ""
     for i = 1 to len(rng.value)
            xtemp = mid(rng.value, i, 1)
            if xtemp like "[0-9.]" then
                xstr = xtemp
            else
                xstr = ""
            end if 
            xout = xout & xstr
      next i 
      rng.value = xout
next
end sub

As you can see it is simply removing everything that is not a number or a period. So as you can imagine I get the following outputs.

122.122.121.12312.13.51.123
.187.213.123.1
.232.123.54.012
.
....

1.124.123.123.123
2.18.12.51.32
3.....

With this I can go through and manually clean up the rows but when I get thousands of rows sometimes it can get tedious. The obvious output I'd like to see is... which deletes empty rows as well.
122.122.121.12
312.13.51.123
187.213.123.1
232.123.54.012
124.123.123.123
18.12.51.32

The next step is where it gets even trickier. I want to be able to cross check those IPs versus a master list to check for duplicates. Now I know I can use conditional formatting to easily highlight duplicates but I also need to check against IP ranges in this format.

2.0.0.0	2.255.255.255
15.42.32.0	15.42.40.255
145.132.123.0	145.140.255.255

<tbody>
</tbody>

My ideal output and final check workbook, if even possible, would look something like this with the Check IP denoting if it is a duplicate value by highlighting itself or other visual queue.

<tbody>
</tbody>

Check IPs	Master Single IP list	Master IP Range List	Master IP Range list
122.122.121.12	7.0.0.0	2.0.0.0	2.255.255.255
312.13.51.123	7.0.0.1	15.42.32.0	15.42.40.255
187.213.123.1	7.0.0.2	145.132.123.0	145.140.255.255
232.123.54.012	7.0.0.3
124.123.123.123	7.0.0.4
18.12.51.32	7.0.0.5

<tbody>
</tbody>

Where the values in the Check IP Column can be changed fluidly but is checked against the "Master Single IP list" and against all IPs within the ranges of "Master IP Range List"

Any attempts would need to be able to scale to be able to handle thousands of IPs if possible...

I know this is asking a lot, especially for a brand new member, but this would be a great way to streamline a tedious task I do daily...

Thank You in Advance.

 

[jasonb75]

I think this should work.

Have columns A and B empty, Single IP master list in column C, IP range list in columns D and E.

Paste the data from the word document into A2 then run the code.

Note that for the purpose of testing, this code shows a message box for each IP from the word document that is found in either of the master lists, so would be better to test with a short list / word document.

Option Explicit
Sub Check_IPs()
Dim n As Long, x As Long, y As Long
Dim wrdrng As Range, outrng As Range, IPsn As Range, IPstart As Variant, IPend As Variant
Dim c As Range, outrow As Long, xarr As Long, tmpArr As Variant, xcheckarr As Long
Dim cIPfound As Range, IPstr As String, IPsplit As Long, sIPstart As String, sIPend As String

Set wrdrng = Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
Set outrng = Range("B2")
Set IPsn = Range("C2:C" & Cells(Rows.Count, 3).End(xlUp).Row)
IPstart = Application.Transpose(Range("D2:D" & Cells(Rows.Count, 4).End(xlUp).Row))
IPend = Application.Transpose(Range("E2:E" & Cells(Rows.Count, 5).End(xlUp).Row))
ReDim checkarr(0 To 2 * UBound(IPstart)) As Variant
For n = 1 To UBound(IPstart)
    sIPstart = "": sIPend = ""
    For x = 0 To 3
        sIPstart = sIPstart & Format(Split(IPstart(n), ".")(x), "000")
        sIPend = sIPend & Format(Split(IPend(n), ".")(x), "000")
    Next
    checkarr(xcheckarr) = sIPstart
    checkarr(xcheckarr + 1) = sIPend
    xcheckarr = xcheckarr + 2
Next

For Each c In wrdrng
    tmpArr = Split(c, " ")
    For xarr = 0 To UBound(tmpArr)
        If tmpArr(xarr) Like "#*.#*.#*.#*" Then
            outrng.Offset(outrow) = tmpArr(xarr)
            outrow = outrow + 1
            Set cIPfound = IPsn.Find(What:=tmpArr(xarr), Lookat:=xlWhole)
            If Not cIPfound Is Nothing Then
                MsgBox "Found " & tmpArr(xarr) & " in single IP list."
            Else
                IPstr = ""
                For IPsplit = 0 To 3
                    IPstr = IPstr & Format(Split(tmpArr(xarr), ".")(IPsplit), "000")
                Next
                For y = 0 To UBound(checkarr) - 1
                    If IPstr > checkarr(y) And IPstr < checkarr(y + 1) And y Mod 2 = 0 Then
                        MsgBox "Found " & tmpArr(xarr) & " in IP range list." & vbCrLf & "Found in the range of " & IPstart(Int(y / 2) + 1) & " to " & IPend(Int(y / 2) + 1)
                        Exit For
                    End If
                Next
            End If
        End If
    Next
Next
    outrng.Offset(outrow).Resize(Cells(Rows.Count, 2).End(xlUp).Row, 1).ClearContents
End Sub

 

[birdman91]

You my friend are a god **** genius.

I hate to even nitpick but is there a way where instead of that message box could it write it to say column C right next to the IP and we can move the master list over one cell?

I tried to do it myself but it seems that if I make any changes to it I'll just return with an error...

 

[jasonb75]

That's easily done, the message box method was only intended for testing anyway. I find that it makes it easier to spot an incorrect result that could be missed if you were just looking at columns of data.

The code is set up to overwrite / clear any old records if you re-run it, do you need it to append new records to the existing list in that case?

Option Explicit
Sub Check_IPs()
Dim n As Long, x As Long, y As Long, bFound As Boolean
Dim wrdrng As Range, outrng As Range, IPsn As Range, IPstart As Variant, IPend As Variant
Dim c As Range, outrow As Long, xarr As Long, tmpArr As Variant, xcheckarr As Long
Dim cIPfound As Range, IPstr As String, IPsplit As Long, sIPstart As String, sIPend As String

Set wrdrng = Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
Set outrng = Range("B2")
Set IPsn = Range("D2:D" & Cells(Rows.Count, 4).End(xlUp).Row)
IPstart = Application.Transpose(Range("E2:E" & Cells(Rows.Count, 5).End(xlUp).Row))
IPend = Application.Transpose(Range("F2:F" & Cells(Rows.Count, 6).End(xlUp).Row))
ReDim checkarr(0 To 2 * UBound(IPstart)) As Variant
For n = 1 To UBound(IPstart)
    sIPstart = "": sIPend = ""
    For x = 0 To 3
        sIPstart = sIPstart & Format(Split(IPstart(n), ".")(x), "000")
        sIPend = sIPend & Format(Split(IPend(n), ".")(x), "000")
    Next
    checkarr(xcheckarr) = sIPstart
    checkarr(xcheckarr + 1) = sIPend
    xcheckarr = xcheckarr + 2
Next

For Each c In wrdrng
    tmpArr = Split(c, " ")
    For xarr = 0 To UBound(tmpArr)
        If tmpArr(xarr) Like "#*.#*.#*.#*" Then
            outrng.Offset(outrow) = tmpArr(xarr)
            bFound = False
            Set cIPfound = IPsn.Find(What:=tmpArr(xarr), Lookat:=xlWhole)
            If Not cIPfound Is Nothing Then
                outrng.Offset(outrow, 1) = "Exact Match Found."
                bFound = True
            Else
                IPstr = ""
                For IPsplit = 0 To 3
                    IPstr = IPstr & Format(Split(tmpArr(xarr), ".")(IPsplit), "000")
                Next
                For y = 0 To UBound(checkarr) - 1
                    If IPstr > checkarr(y) And IPstr < checkarr(y + 1) And y Mod 2 = 0 Then
                        outrng.Offset(outrow, 1) = "Found in the range of " & IPstart(Int(y / 2) + 1) & " to " & IPend(Int(y / 2) + 1)
                        bFound = True
                        Exit For
                    End If
                Next
            End If
            outrow = outrow + 1
        End If
        If bFound = False Then outrng.Offset(outrow, 1).ClearContents
    Next
Next
    outrng.Offset(outrow).Resize(Cells(Rows.Count, 2).End(xlUp).Row, 2).ClearContents
End Sub

 

[birdman91]

For some reason the "Found In" Column... Column C, is writing one row down then it should.

 

[jasonb75]

Strange, it's not doing that to me.

Is it the same for all rows, or just some?

Are there any merged cells in rows 1 and 2?

 

[birdman91]

Nevermind... It was a stupid copy paste error. That is working.

I think this is that last thing I will ask you... then will thank you as much as humanly possible.

Since the reports are coming from all over they are not in a standardized form. Some IPs have leading zeros like 001.023.021.000 or in 1.23.21.0. So I was thinking that have leading zeros in the 000.000.000.000 would be the best standard format. Also sometimes the IPs fall at the end of a sentence and thus can pull periods into the format such as 123.123.123.121. and the search gets messed up. I was thinking if i modified the outrng you had it would solve both things at once but it doesnt look like I'm that good yet haha

I tried doing something like

tmparr(xarr) = format("4.23.243.14", 000.000.000.000)

But I think I'm way off.

 

[birdman91]

Missed the edit window... Added that it can also pull in ", : ; " essentially any punctuation that falls at the end of the IP

Also sometimes the IPs fall at the end of a sentence and thus can pull periods, commas, and some other punctuation into the format such as 123.123.123.121. or 123.123.123.121; and the search gets messed up. I was thinking if i modified the outrng you had it would solve both things at once but it doesn't look like I'm that good yet haha

 

[jasonb75]

The leading zeros shouldn't cause problems, the only place that the code doesn't allow for that is in the single IP master list, but that can be easily rectified by using the same method as the range list.

The trailing punctuation can be dealt with as part of the same process by testing the last character in the string, if it's numeric, keep it, if not, remove it.

If only I could type that in code as easily as I can in English lol.

I'll make the changes to the code when I get home later.

 

[jasonb75]

Just thinking beyond your last post slightly.

Is a single stray punctuation character at the end of the string all that needs to be allowed for, or could there be multiple trailing (or even leading) characters?

 

[jasonb75]

Ok, see if you can break this lol.

Aside from an unbroken string (i.e. no spaces) that contains numeric characters which are not part of the IP address, this should find and extract an IP from just about anything.

Option Explicit
Sub Check_IPs()
With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
Dim n As Long, x As Long, y As Long, bFound As Boolean, IPsingle As Variant, sIPsingle As String
Dim wrdrng As Range, outrng As Range, IPstart As Variant, IPend As Variant
Dim c As Range, outrow As Long, xarr As Long, tmpArr As Variant, xcheckarr As Long
Dim IPstr As String, IPsplit As Long, sIPstart As String, sIPend As String
Set wrdrng = Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
Set outrng = Range("B2")
    IPsingle = .Transpose(Range("D2:D" & Cells(Rows.Count, 4).End(xlUp).Row))
    IPstart = .Transpose(Range("E2:E" & Cells(Rows.Count, 5).End(xlUp).Row))
    IPend = .Transpose(Range("F2:F" & Cells(Rows.Count, 6).End(xlUp).Row))
ReDim checkarr(0 To 2 * UBound(IPstart)) As Variant
For n = 1 To UBound(IPstart)
    sIPstart = "": sIPend = ""
    For x = 0 To 3
        sIPstart = sIPstart & Format(Split(IPstart(n), ".")(x), "000")
        sIPend = sIPend & Format(Split(IPend(n), ".")(x), "000")
    Next
    checkarr(xcheckarr) = sIPstart
    checkarr(xcheckarr + 1) = sIPend
    xcheckarr = xcheckarr + 2
Next
For n = 1 To UBound(IPsingle)
    sIPsingle = ""
    For x = 0 To 3
        sIPsingle = sIPsingle & Format(Split(IPsingle(n), ".")(x), "000")
    Next
    IPsingle(n) = sIPsingle
Next
For Each c In wrdrng
    tmpArr = Split(c, " ")
    For xarr = 0 To UBound(tmpArr)
        If tmpArr(xarr) Like "*#*.#*.#*.#*" Then
            While Right(tmpArr(xarr), 1) Like "[!0-9]"
                tmpArr(xarr) = Left(tmpArr(xarr), Len(tmpArr(xarr)) - 1)
            Wend
            While Left(tmpArr(xarr), 1) Like "[!0-9]"
                tmpArr(xarr) = Right(tmpArr(xarr), Len(tmpArr(xarr)) - 1)
            Wend
            outrng.Offset(outrow) = tmpArr(xarr)
            bFound = False
            IPstr = ""
            For IPsplit = 0 To 3
                IPstr = IPstr & Format(Split(tmpArr(xarr), ".")(IPsplit), "000")
            Next
            For y = 1 To UBound(IPsingle)
                If IPstr = IPsingle(y) Then
                    bFound = True
                    outrng.Offset(outrow, 1) = "Exact match found in Single IP master list."
                    Exit For
                End If
            Next
            If bFound = False Then
                For y = 0 To UBound(checkarr) - 1
                    If IPstr >= checkarr(y) And IPstr <= checkarr(y + 1) And y Mod 2 = 0 Then
                        outrng.Offset(outrow, 1) = "Found in the range of " & IPstart(Int(y / 2) + 1) & " to " & IPend(Int(y / 2) + 1)
                        bFound = True
                        Exit For
                    End If
                Next
            End If
            outrow = outrow + 1
        End If
        If bFound = False Then outrng.Offset(outrow, 1).ClearContents
    Next
Next
    outrng.Offset(outrow).Resize(Cells(Rows.Count, 2).End(xlUp).Row, 2).ClearContents
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
End With
End Sub