Expanding IP ranges thru 3 octets

Danny54

Active Member
Joined
Jul 3, 2019
Messages
295
Office Version
  1. 365
Platform
  1. Windows
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
A10.10.10.0
B10.10.10.0-10.10.10.2
C10.10.10.0-10.10.10.255
D10.10.10.0-10.10.11.0
E10.10.10.0-10.11.11.0
F10.15.1.0-10.15.1.5,10.15.2.3-10.15.2.5


Output from the VBA Script above

CompanyIP RangeResults from VBA ScriptDescription of Results
A10.10.10.010.10.10.0ok
B10.10.10.0-10.10.10.210.10.10.0, 10.10.10.1, 10.10.10.2ok
C10.10.10.0-10.10.10.25510.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.255ok
D10.10.10.0-10.10.11.010.10.10.0doesn’t show correct values
E10.10.10.0-10.11.11.010.10.10.0doesn’t show correct values
F10.15.1.0-10.15.1.5,10.15.2.3-10.15.2.510.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.5ok
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.
 
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
 
Upvote 0

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.

Forum statistics

Threads
1,223,228
Messages
6,170,871
Members
452,363
Latest member
merico17

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top