Extract ip address row from a ip range and subnet mask

[IKHAN]

Hello ..
I am trying to find a vba script for column A in sheet1 that will check an IP address in sheet2 column C (start of IP address) and column F (Subnetmask) and find if it falls into a range (or between). If IP available in range, I want to copy complete row into sheet1 column B. If IP not available, I want to add message "IP unavailable".
Have uploaded test file.

Any help on this please.

 

[IKHAN]

I found this online and tweaked a bit,,Getting run time error 13 and stops at 'ipArray = Split(ip, ".") '

>>> use code - tags <<<

Sub CheckIPAddress2()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim ip As String, startIP As String, subnetMask As String
    Dim ipRange As Range, cell As Range
    Dim found As Boolean

    Set ws1 = Worksheets("Sheet1")
    Set ws2 = Worksheets("Sheet2")

    ip = ws1.Range("A2").Value
    Set ipRange = ws2.Range("C1:C" & ws2.Cells(ws2.Rows.Count, "C").End(xlUp).Row)

    found = False

    For Each cell In ipRange
        startIP = cell.Value
        subnetMask = cell.Offset(0, 3).Value

        If IPAddressInRange(ip, startIP, subnetMask) Then
            found = True
            cell.EntireRow.Copy Destination:=ws1.Cells(2, 2)
            Exit For
        End If
    Next cell

    If Not found Then
        ws1.Range("B2").Value = "IP unavailable"
    End If
End Sub

Function IPAddressInRange(ip As String, startIP As String, subnetMask As String) As Boolean
    Dim ipArray() As Byte, startIPArray() As Byte, subnetMaskArray() As Byte
    Dim i As Integer

    ipArray = Split(ip, ".")
    startIPArray = Split(startIP, ".")
    subnetMaskArray = Split(subnetMask, ".")

    For i = 0 To 3
        If (ipArray(i) And subnetMaskArray(i)) <> (startIPArray(i) And subnetMaskArray(i)) Then
            IPAddressInRange = False
            Exit Function
        End If
    Next i

    IPAddressInRange = True
End Function

 

[rlv01]

Perhaps this fix-up

Sub CheckIPAddress2()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim ip As String, startIP As String, subnetMask As String
    Dim ipRange As Range, cell As Range
    Dim found As Boolean

    Set ws1 = Worksheets("Sheet1")
    Set ws2 = Worksheets("Sheet2")

    ip = ws1.Range("A2").Value
    Set ipRange = ws2.Range("C2:C" & ws2.Cells(ws2.Rows.Count, "C").End(xlUp).Row)

    found = False

    For Each cell In ipRange
        startIP = cell.Value
        subnetMask = cell.Offset(0, 3).Value

        If IPAddressInRange(ip, startIP, subnetMask) Then
            found = True
            Application.Intersect(cell.EntireRow, ws2.UsedRange).Copy Destination:=ws1.Cells(2, 2)
            Exit For
        End If
    Next cell

    If Not found Then
        ws1.Range("B2").Value = "IP unavailable"
    End If
End Sub

Function IPAddressInRange(ip As String, startIP As String, subnetMask As String) As Boolean
    'Dim ipArray() As Byte, startIPArray() As Byte, subnetMaskArray() As Byte
    Dim ipArray As Variant, startIPArray As Variant, subnetMaskArray As Variant
    Dim i As Integer

    ipArray = Split(ip, ".")
    startIPArray = Split(startIP, ".")
    subnetMaskArray = Split(subnetMask, ".")

    For i = 0 To 3
    Debug.Print ipArray(i) & ":" & subnetMaskArray(i) & ":" & startIPArray(i) & ":" & subnetMaskArray(i)
        If (ipArray(i) And subnetMaskArray(i)) <> (startIPArray(i) And subnetMaskArray(i)) Then
            IPAddressInRange = False
            Exit Function
        End If
    Next i

    IPAddressInRange = True
End Function

 

[IKHAN]

Perhaps this fix-up

Sub CheckIPAddress2()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim ip As String, startIP As String, subnetMask As String
    Dim ipRange As Range, cell As Range
    Dim found As Boolean

    Set ws1 = Worksheets("Sheet1")
    Set ws2 = Worksheets("Sheet2")

    ip = ws1.Range("A2").Value
    Set ipRange = ws2.Range("C2:C" & ws2.Cells(ws2.Rows.Count, "C").End(xlUp).Row)

    found = False

    For Each cell In ipRange
        startIP = cell.Value
        subnetMask = cell.Offset(0, 3).Value

        If IPAddressInRange(ip, startIP, subnetMask) Then
            found = True
            Application.Intersect(cell.EntireRow, ws2.UsedRange).Copy Destination:=ws1.Cells(2, 2)
            Exit For
        End If
    Next cell

    If Not found Then
        ws1.Range("B2").Value = "IP unavailable"
    End If
End Sub

Function IPAddressInRange(ip As String, startIP As String, subnetMask As String) As Boolean
    'Dim ipArray() As Byte, startIPArray() As Byte, subnetMaskArray() As Byte
    Dim ipArray As Variant, startIPArray As Variant, subnetMaskArray As Variant
    Dim i As Integer

    ipArray = Split(ip, ".")
    startIPArray = Split(startIP, ".")
    subnetMaskArray = Split(subnetMask, ".")

    For i = 0 To 3
    Debug.Print ipArray(i) & ":" & subnetMaskArray(i) & ":" & startIPArray(i) & ":" & subnetMaskArray(i)
        If (ipArray(i) And subnetMaskArray(i)) <> (startIPArray(i) And subnetMaskArray(i)) Then
            IPAddressInRange = False
            Exit Function
        End If
    Next i

    IPAddressInRange = True
End Function

Thanks. Works only for first row in sheet1,Doesn't check on other rows in sheet1

 

[rlv01]

Thanks. Works only for first row in sheet1,Doesn't check on other rows in sheet1

Yes, as per your original code: cell.EntireRow.Copy Destination:=ws1.Cells(2, 2)

If you want something different, you will have to describe it in an understandable way. Pehaps consider uploading another workbook containing a "before" and "after" example.

 

[IKHAN]

Report

@rlv01... Thanks for assisting.​

Have uploaded both Before and After files.​

Have added sample 5 rows data in column A.
Have approx. 4000 rows of ip address in my original file.