Expanding IP ranges thru 3 octets

[Danny54]

Good Morning

I'm trying to modify the following VBA code in order to expand the values found in a ip range

The vba coded currently works successfully with the 4th octet
ie. 10.10.10.1-10.10.10.3 would be expanded to show 10.10.10.1, 10.10.10.2, 10.10.10.3
ie. 10.10.10.1-10.10.10.3, 10.10.20.5-10.10.20.6 would be expanded to show 10.10.10.1, 10.10.10.2, 10.10.10.3 , 10.10.20.5, 10.10.20.6

Note Octet information
10.20.30.1 = octet are counted from left to right. (this example show 10 is the 1st octet, 20 is second octet, 30 is the 3rd octet and 1 is the 4th octet)
each octet is counted from 0-255
once we hit 255 in any octet the next increased ip would be using the octet to the left .. 10.10.10.255, 10.10.11.0, 10.10.11.1

The code needs to be modified to work with the 3rd octet and potentially the 4th

ie... For the following ip range 10.10.10.1-10.10.11.255 should be expanded to show 10.10.10.1, .... 10.10.10.255 .... 10.10.11.0, .... 10.10.11,255


Code:
Sub doIt()
Dim rng As Range
Dim cll As Range
Dim commaSeparated
Dim dashSeparated
Dim commaItem
Dim bytes
Dim lastByteFrom As Double
Dim firstThreeBytes As String
Dim lastByteTo As Double
Dim i As Double
Dim result() As String

Range("C1").ClearContents

Set rng = Selection ' select all values in column B
For Each cll In rng.Cells
ReDim result(0)
commaSeparated = Split(cll.Value, ",")

For Each commaItem In commaSeparated
dashSeparated = Split(Trim(commaItem), "-")

If UBound(dashSeparated) = 1 Then
bytes = Split(dashSeparated(0), ".")
lastByteFrom = bytes(3)
ReDim Preserve bytes(2)
firstThreeBytes = Join(bytes, ".")
lastByteTo = Split(dashSeparated(1), ".")(3)

For i = 0 To lastByteTo - lastByteFrom
ReDim Preserve result(UBound(result) + 1)
result(UBound(result)) = firstThreeBytes & "." & (lastByteFrom + i)
Next i

Else
ReDim Preserve result(UBound(result) + 1)
result(UBound(result)) = Trim(commaItem)
End If

Next commaItem
If UBound(commaSeparated) > -1 Then
For i = 1 To UBound(result)
result(i - 1) = result(i)
Next i
ReDim Preserve result(UBound(result) - 1)
cll.Offset(, 1).Value = Join(result, ", ")
End If

Next cll
End Sub


Test Data

A	10.10.10.0
B	10.10.10.0-10.10.10.2
C	10.10.10.0-10.10.10.255
D	10.10.10.0-10.10.11.0
E	10.10.10.0-10.11.11.0
F	10.15.1.0-10.15.1.5,10.15.2.3-10.15.2.5

Output from the VBA Script above

Company	IP Range	Results from VBA Script	Description of Results
A	10.10.10.0	10.10.10.0	ok
B	10.10.10.0-10.10.10.2	10.10.10.0, 10.10.10.1, 10.10.10.2	ok
C	10.10.10.0-10.10.10.255	10.10.10.0, 10.10.10.1, 10.10.10.2, 10.10.10.3, 10.10.10.4, 10.10.10.5, 10.10.10.6, 10.10.10.7, 10.10.10.8, 10.10.10.9, 10.10.10.10, 10.10.10.11, 10.10.10.12, 10.10.10.13, 10.10.10.14, 10.10.10.15, 10.10.10.16, 10.10.10.17, 10.10.10.18, 10.10.10.19, 10.10.10.20, 10.10.10.21, 10.10.10.22, 10.10.10.23, 10.10.10.24, 10.10.10.25, 10.10.10.26, 10.10.10.27, 10.10.10.28, 10.10.10.29, 10.10.10.30, 10.10.10.31, 10.10.10.32, 10.10.10.33, 10.10.10.34, 10.10.10.35, 10.10.10.36, 10.10.10.37, 10.10.10.38, 10.10.10.39, 10.10.10.40, 10.10.10.41, 10.10.10.42, 10.10.10.43, 10.10.10.44, 10.10.10.45, 10.10.10.46, 10.10.10.47, 10.10.10.48, 10.10.10.49, 10.10.10.50, 10.10.10.51, 10.10.10.52, 10.10.10.53, 10.10.10.54, 10.10.10.55, 10.10.10.56, 10.10.10.57, 10.10.10.58, 10.10.10.59, 10.10.10.60, 10.10.10.61, 10.10.10.62, 10.10.10.63, 10.10.10.64, 10.10.10.65, 10.10.10.66, 10.10.10.67, 10.10.10.68, 10.10.10.69, 10.10.10.70, 10.10.10.71, 10.10.10.72, 10.10.10.73, 10.10.10.74, 10.10.10.75, 10.10.10.76, 10.10.10.77, 10.10.10.78, 10.10.10.79, 10.10.10.80, 10.10.10.81, 10.10.10.82, 10.10.10.83, 10.10.10.84, 10.10.10.85, 10.10.10.86, 10.10.10.87, 10.10.10.88, 10.10.10.89, 10.10.10.90, 10.10.10.91, 10.10.10.92, 10.10.10.93, 10.10.10.94, 10.10.10.95, 10.10.10.96, 10.10.10.97, 10.10.10.98, 10.10.10.99, 10.10.10.100, 10.10.10.101, 10.10.10.102, 10.10.10.103, 10.10.10.104, 10.10.10.105, 10.10.10.106, 10.10.10.107, 10.10.10.108, 10.10.10.109, 10.10.10.110, 10.10.10.111, 10.10.10.112, 10.10.10.113, 10.10.10.114, 10.10.10.115, 10.10.10.116, 10.10.10.117, 10.10.10.118, 10.10.10.119, 10.10.10.120, 10.10.10.121, 10.10.10.122, 10.10.10.123, 10.10.10.124, 10.10.10.125, 10.10.10.126, 10.10.10.127, 10.10.10.128, 10.10.10.129, 10.10.10.130, 10.10.10.131, 10.10.10.132, 10.10.10.133, 10.10.10.134, 10.10.10.135, 10.10.10.136, 10.10.10.137, 10.10.10.138, 10.10.10.139, 10.10.10.140, 10.10.10.141, 10.10.10.142, 10.10.10.143, 10.10.10.144, 10.10.10.145, 10.10.10.146, 10.10.10.147, 10.10.10.148, 10.10.10.149, 10.10.10.150, 10.10.10.151, 10.10.10.152, 10.10.10.153, 10.10.10.154, 10.10.10.155, 10.10.10.156, 10.10.10.157, 10.10.10.158, 10.10.10.159, 10.10.10.160, 10.10.10.161, 10.10.10.162, 10.10.10.163, 10.10.10.164, 10.10.10.165, 10.10.10.166, 10.10.10.167, 10.10.10.168, 10.10.10.169, 10.10.10.170, 10.10.10.171, 10.10.10.172, 10.10.10.173, 10.10.10.174, 10.10.10.175, 10.10.10.176, 10.10.10.177, 10.10.10.178, 10.10.10.179, 10.10.10.180, 10.10.10.181, 10.10.10.182, 10.10.10.183, 10.10.10.184, 10.10.10.185, 10.10.10.186, 10.10.10.187, 10.10.10.188, 10.10.10.189, 10.10.10.190, 10.10.10.191, 10.10.10.192, 10.10.10.193, 10.10.10.194, 10.10.10.195, 10.10.10.196, 10.10.10.197, 10.10.10.198, 10.10.10.199, 10.10.10.200, 10.10.10.201, 10.10.10.202, 10.10.10.203, 10.10.10.204, 10.10.10.205, 10.10.10.206, 10.10.10.207, 10.10.10.208, 10.10.10.209, 10.10.10.210, 10.10.10.211, 10.10.10.212, 10.10.10.213, 10.10.10.214, 10.10.10.215, 10.10.10.216, 10.10.10.217, 10.10.10.218, 10.10.10.219, 10.10.10.220, 10.10.10.221, 10.10.10.222, 10.10.10.223, 10.10.10.224, 10.10.10.225, 10.10.10.226, 10.10.10.227, 10.10.10.228, 10.10.10.229, 10.10.10.230, 10.10.10.231, 10.10.10.232, 10.10.10.233, 10.10.10.234, 10.10.10.235, 10.10.10.236, 10.10.10.237, 10.10.10.238, 10.10.10.239, 10.10.10.240, 10.10.10.241, 10.10.10.242, 10.10.10.243, 10.10.10.244, 10.10.10.245, 10.10.10.246, 10.10.10.247, 10.10.10.248, 10.10.10.249, 10.10.10.250, 10.10.10.251, 10.10.10.252, 10.10.10.253, 10.10.10.254, 10.10.10.255	ok
D	10.10.10.0-10.10.11.0	10.10.10.0	doesn’t show correct values
E	10.10.10.0-10.11.11.0	10.10.10.0	doesn’t show correct values
F	10.15.1.0-10.15.1.5,10.15.2.3-10.15.2.5	10.15.1.0, 10.15.1.1, 10.15.1.2, 10.15.1.3, 10.15.1.4, 10.15.1.5, 10.15.2.3, 10.15.2.4, 10.15.2.5	ok
G	10.25.25.127- 10.25.26.3		throws subscript out of range because ending 4th octet in second range is lower than 4th octet in first range.

 

[Danny54]

Figured a way to get it to work although probably not the right way. (see words Inserted)

Thanks


Sub ExpandIP()
Application.ScreenUpdating = False
Dim r As Range: Set r = Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
Dim AR() As Variant: AR = r.Value2
Dim SP() As String
Dim IP() As String
Dim rLen As Long

With CreateObject("Scripting.Dictionary")
For i = 1 To UBound(AR)
If InStr(AR(i, 1), "-") > 0 Then
SP = Split(AR(i, 1), ",")
For J = 0 To UBound(SP)
If InStr(SP(J), "-") > 0 Then 'Inserted
IP = Split(SP(J), "-")
.Add CountIP(IP(0), IP(1)), 1
Else ' Inserted
IP = Split(SP(J), "-") ' Inserted
.Add CountIP(IP(0), IP(0)), 1 ' Inserted
End If ' Inserted
Next J
Else
.Add AR(i, 1), 1
End If

rLen = Len(Join(.Keys, ", "))
If rLen > 32767 Then
Cells(i + 1, 3).Value = "Range too large. Results " & Format(rLen, "#,##0") & " characters long."
Else
Cells(i + 1, 3).Value = Join(.Keys, ",")
End If
.RemoveAll
Next i
End With

Application.ScreenUpdating = True
End Sub

Function CountIP(SIP As String, EIP As String)
Dim IP1() As String: IP1 = Split(SIP, ".")
Dim IP2() As String: IP2 = Split(EIP, ".")
Dim b As Boolean: b = True

With CreateObject("System.Collections.ArrayList")
Do Until Join(IP1, ".") = Join(IP2, ".")
b = True
For i = 1 To 3
If IP1(i) = 256 Then
IP1(i - 1) = IP1(i - 1) + 1
IP1(i) = 0
b = False
End If
Next i
.Add Join(IP1, ".")
If b Then IP1(3) = IP1(3) + 1
Loop
.Add Join(IP1, ".")
CountIP = Join(.toArray, ",")
End With
End Function