Expand IP Ranges

[Danny54]

Can anyone help me with the following?

I have a spreadsheet containing data having IP addresses in which I need to create a output text file.

A sample input file would look like this

owner	active	group	address	exp
a	1​	gray	10.10.10.10	1/1/2023​
b	1​	blue	10.10.10.12-10.10.10.15	1/1/2023​
c	1​	red	10.10.10.20-10.10.10.25, 192.168.1.1-192.168.1.2,192.168.10.10	1/1/2023​

the output .txt file would look like this

owner	active	group	address	exp
a	1​	gray	10.10.10.10	1/1/2023​
b	1​	blue	10.10.10.12	1/1/2023​
b	1​	blue	10.10.10.13	1/1/2023​
b	1​	blue	10.10.10.14	1/1/2023​
b	1​	blue	10.10.10.15	1/1/2023​
c	1​	red	10.10.10.20	1/1/2023​
c	1​	red	10.10.10.21	1/1/2023​
c	1​	red	10.10.10.22	1/1/2023​
c	1​	red	10.10.10.23	1/1/2023​
c	1​	red	10.10.10.24	1/1/2023​
c	1​	red	10.10.10.25	1/1/2023​
c	1​	red	192.168.1.1	1/1/2023​
c	1​	red	192.168.1.2	1/1/2023​
c	1​	red	192.168.10.10	1/1/2023​

Thanks

 

[johnnyL]

Didn't @lrobbo314 solve this for you previously?

 

[Danny54]

need it written to a txt output file

 

[johnnyL]

An example of copying to a .txt file:

    DestinationWS.UsedRange.Copy                                                                                ' Copy all data to clipboard
'
    strData = CreateObject("htmlfile").ParentWindow.ClipboardData.GetData("Text")                               ' Save contents into strData
'
    strTempFile = "C:\Users\" & Environ("username") & "\Desktop\output.txt"                                     ' <--- Set Path & file name to save the data into
    CreateObject("Scripting.FileSystemObject").CreateTextFile(strTempFile, True).Write strData                  ' Write the data to file
'
    Application.CutCopyMode = False                                                                             ' Clear the clipboard & 'marching ants'

 

[Danny54]

Thanks, johnnyL

The code that @lrobbo314 created expected all the data to fit into one xls sheet. Going thru my IP ranges i'm finding that the max rows are exceeded expanding several ip ranges.
Therefore, the code needs to write one line at a time to a txt file when expanding the IP values. This way there is on limitation on expanding values such as 10.0.0.0 - 10.255.255.255

Hope this makes since.

Thanks for the help

 

[johnnyL]

Assuming you want the results to mimic what you posted in post #1 here,
How many rows do you expect to use?

I assume that you know that if you wanted to display all results of 10.0.0.0 through 10.255.255.255 separately on each row ... that would be over 16 million rows.

 

[Danny54]

Thanks for your reply. You are correct and after looking at my values, they never go that far. The max is normally something like this 10.0.103.128-10.0.105.255.
It's actually the combination of all rows with IP's being expanded (one after the other) and inserted into the sheet that pushes the max limit for rows.
Thought was by creating a text file while staying in the look, would remove the max limit.
I don't know vb well enough to make the modification as to read one line at a time, enter a loop to expand the ip and write each line keeping all columns. When done, get the next set of ip's.

Again thanks

 

[Danny54]

Here is some previous code that I never could get to work for this data. If one knew how to adjust it might.
It doesn't keep all row data (owner, active, group, address, exp) and stops and the row limitation when I run against my production file.

This example expects 2 columns
1-owner 2-address

Sub Expandit()
Dim W, S$(), N&, K&, V, L$(), R$(), A%, T$(3), B%, C%, D%
W = [Sheet1!A1].CurrentRegion.Value2
ReDim S(1 To Rows.Count, 1): S(1, 0) = W(1, 1): S(1, 1) = W(1, 2)
N = 1
For K = 2 To UBound(W)
For Each V In Split(W(K, 2), ",")
L = Split(V, "-")
If UBound(L) = 1 Then
R = Split(L(1), ".")
L = Split(L(0), ".")
If UBound(L) = 3 And UBound(R) = 3 Then
For A = L(0) To R(0)
T(0) = A
For B = -L(1) * (A = L(0) * 1) To IIf(A < R(0) * 1, 255, R(1))
T(1) = B
For C = -L(2) * (B = L(1) * 1) To IIf(B < R(1) * 1, 255, R(2))
T(2) = C
For D = -L(3) * (C = L(2) * 1) To IIf(C < R(2) * 1, 255, R(3))
T(3) = D
N = N + 1
S(N, 0) = W(K, 1)
S(N, 1) = Join(T, ".")
Next D, C, B, A
End If
Else
N = N + 1
S(N, 0) = W(K, 1)
S(N, 1) = V
End If
Next V, K
[Sheet2!A1:B1].Resize(N).Value2 = S
End Sub

 

[johnnyL]

I started with the code @lrobbo314 provided you at the beginning of this year, I Threw in some code I found for aligning text written to text file, I forget who I based that code from... Shook all that up and I came up with what should do what you asked.

Try the following and let me know if it accomplishes what you asked for:

Option Explicit

    Dim NotFirstWrite       As Boolean
    Dim IP_AddressRow       As Long
    Dim IP_RangesArrayRow   As Long
    Dim MaxRowsToPrint      As Long
    Dim strTempFile         As String
    Dim IP_RangesArray()    As Variant
    Dim FullOutputArray()   As Variant
    Dim DestinationWS       As Worksheet

Sub ExpandIPs_VerticalV3()
'
    Dim KeepResultsSheet            As Boolean
    Dim ResultsSheetMissing         As Boolean
    Dim ArrayColumn                 As Long
    Dim SplitIP_Range               As Long
    Dim IP_AddressesToExpandArray() As String
    Dim Lower_UpperIP_RangeArray()  As String
    Dim ResultSheetName             As String
    Dim OutputArrayForTxtFile()     As Variant
    Dim SourceWS                    As Worksheet
'
'---------------------------------------------------------------------------------------------------------------
'
    Set SourceWS = Sheets("Sheet1")                                                                             ' <--- Set this to the proper sheet name to get the data from
    ResultSheetName = "Results Sheet"                                                                           ' <--- Set this to the name of the sheet to store results into. This will be
'                                                                                                               '           a temporary sheet unless you choose to keep it for viewing afterwards
'
    KeepResultsSheet = False                                                                                    ' <--- Set this to True to KeepResultsSheet, False to have it deleted when finished
    strTempFile = "C:\Users\" & Environ("username") & "\Desktop\output.txt"                                     ' <--- Set this to the Path & file name to save the results into
'
    MaxRowsToPrint = 10000                                                                                      ' <--- Set this to the number of rows to write to text file each time ... max = 16384
'
'---------------------------------------------------------------------------------------------------------------
'
    Application.ScreenUpdating = False                                                                          ' Turn ScreenUpdating off
'
    If Dir(strTempFile) <> "" Then Kill strTempFile                                                             ' Delete the text file to write to if it exists
'
    ResultsSheetMissing = Evaluate("IsError(Cell(""col"",'" + ResultSheetName + "'!A1))")                       ' If ResultsSheetMissing = False then the sheet does exist
'
    If ResultsSheetMissing = False Then                                                                         ' If the ResultSheetName exists then
        Application.DisplayAlerts = False                                                                       '   Turn DisplayAlerts off ... sheet deletion causes popup
        Sheets(ResultSheetName).Delete                                                                          '   Delete the sheet
        Application.DisplayAlerts = True                                                                        '   Turn DisplayAlerts back on
    End If
'
    Sheets.Add(After:=Sheets(Sheets.Count)).Name = ResultSheetName                                              ' Add the ResultSheet & name it
'
    Set DestinationWS = Sheets(ResultSheetName)                                                                 ' Set the DestinationWS
'
    SourceWS.Columns("D:D").Replace " ", "", xlPart                                                             ' Remove all spacea from IP ranges in column D
'
    NotFirstWrite = False                                                                                       ' Set NotFirstWrite to False to indicate the FirstWrite will occur
'
    IP_RangesArray = SourceWS.Range("A1:E" & SourceWS.Range("D" & SourceWS.Rows.Count).End(xlUp).Row).Value2    ' Load data into 2D 1 based IP_RangesArray
'
    ReDim FullOutputArray(1 To 16384, 1 To UBound(IP_RangesArray, 2))                                           ' Establish size of FullOutputArray
'
'---------------------------------------------------------------------------------------------------------------
'
    For ArrayColumn = 1 To UBound(IP_RangesArray, 2)                                                            ' Loop through columns of IP_RangesArray
        FullOutputArray(1, ArrayColumn) = IP_RangesArray(1, ArrayColumn) & "          "                         '   Copy the Header to FullOutputArray
    Next                                                                                                        ' Loop back
'
    IP_AddressRow = 1                                                                                           ' Initialize the IP_AddressRow
'
    For IP_RangesArrayRow = 2 To UBound(IP_RangesArray, 1)                                                      ' Loop through rows of IP_RangesArray
        If InStr(IP_RangesArray(IP_RangesArrayRow, 4), "-") > 0 Then                                            '   If the row contains '-' then ... IP range needs to be expanded
            IP_AddressesToExpandArray = Split(IP_RangesArray(IP_RangesArrayRow, 4), ",")                        '       Split the AddressesToExpand according to commas
'
            For SplitIP_Range = 0 To UBound(IP_AddressesToExpandArray)                                          '       Loop through the 1D zero based IP_AddressesToExpandArray
                Lower_UpperIP_RangeArray = Split(IP_AddressesToExpandArray(SplitIP_Range), "-")                 '           Split the IP_AddressesToExpand according to dashes
'
                On Error Resume Next                                                                            '           If error encountered, proceed to the next line of code
                Call SequenceIP_AddressRange_Vertical(Lower_UpperIP_RangeArray(0), Lower_UpperIP_RangeArray(1)) '
                If Err.Number <> 0 Then                                                                         '           If an error occurred then no Lower_UpperIP_RangeArray(1) found ...
                    IP_AddressRow = IP_AddressRow + 1                                                           '               Increment IP_AddressRow
                    FullOutputArray(IP_AddressRow, 1) = IP_RangesArray(IP_RangesArrayRow, 1)                    '               Save Owner to FullOutputArray
                    FullOutputArray(IP_AddressRow, 2) = IP_RangesArray(IP_RangesArrayRow, 2)                    '               Save Active to FullOutputArray
                    FullOutputArray(IP_AddressRow, 3) = IP_RangesArray(IP_RangesArrayRow, 3)                    '               Save Group to FullOutputArray
                    FullOutputArray(IP_AddressRow, 4) = Lower_UpperIP_RangeArray(0)                             '               Save IP address to FullOutputArray
                    FullOutputArray(IP_AddressRow, 5) = Format(IP_RangesArray(IP_RangesArrayRow, 5), "m/d/yyyy")    '               Save exp to FullOutputArray
                    On Error GoTo 0                                                                             '               Clear errors & return error handling to Excel
                End If
'
                If IP_AddressRow = MaxRowsToPrint Then Call WriteToTextFile                                     '               If we have reached the MaxRowsToPrint then write results to file
            Next                                                                                                '       Loop back
        Else                                                                                                    '   Else ... Single IP address
            IP_AddressRow = IP_AddressRow + 1                                                                   '       Increment IP_AddressRow
            FullOutputArray(IP_AddressRow, 1) = IP_RangesArray(IP_RangesArrayRow, 1)                            '       Save Owner to FullOutputArray
            FullOutputArray(IP_AddressRow, 2) = IP_RangesArray(IP_RangesArrayRow, 2)                            '       Save Active to FullOutputArray
            FullOutputArray(IP_AddressRow, 3) = IP_RangesArray(IP_RangesArrayRow, 3)                            '       Save Group to FullOutputArray
            FullOutputArray(IP_AddressRow, 4) = IP_RangesArray(IP_RangesArrayRow, 4)                            '       Save IP address to FullOutputArray
            FullOutputArray(IP_AddressRow, 5) = Format(IP_RangesArray(IP_RangesArrayRow, 5), "m/d/yyyy")        '       Save exp to FullOutputArray
        End If
'
        If IP_AddressRow = MaxRowsToPrint Then Call WriteToTextFile                                             '   If we have reached the MaxRowsToPrint then write results to file
    Next                                                                                                        ' Loop back
'
    Call WriteToTextFile                                                                                        ' Write remaining results to file
'
'---------------------------------------------------------------------------------------------------------------
'
    If KeepResultsSheet = False Then                                                                            ' If user chose not to keep ResultsSheet then ...
        Application.DisplayAlerts = False                                                                       '   Turn DisplayAlerts off ... sheet deletion causes popup
        Sheets(ResultSheetName).Delete                                                                          '   Delete the ResultsSheet
        Application.DisplayAlerts = True                                                                        '   Turn DisplayAlerts back on
    Else                                                                                                        ' Else ...
        DestinationWS.UsedRange.EntireColumn.AutoFit                                                            '   Fit all remaining data to columns in the destination sheetg
    End If
'
    Application.ScreenUpdating = True                                                                           ' Turn ScreenUpdating back on
'
MsgBox "Done!"                                                                                                  ' Let the user know that the script has finished
End Sub


Private Sub WriteToTextFile()
'
    Dim ArrayColumn                 As Long
    Dim ArrayRow                    As Long
    Dim LastColumnNumberUsedInSheet As Long
    Dim MaxCellLength               As Long
    Dim strData                     As String
'
    FullOutputArray = Application.Transpose(FullOutputArray)                                                    ' Transpose the FullOutputArray for resizing
'
    ReDim Preserve FullOutputArray(1 To UBound(FullOutputArray, 1), 1 To IP_AddressRow)                         ' Correct the size of FullOutputArray to actual number of rows needed
'
    FullOutputArray = Application.Transpose(FullOutputArray)                                                    ' Transpose the FullOutputArray back
'
'---------------------------------------------------------------------------------------------------------------
'
    DestinationWS.UsedRange.Clear                                                                               ' Erase previous results from destination sheet
    DestinationWS.Range("A1").Resize(UBound(FullOutputArray, 1), UBound(FullOutputArray, 2)) = FullOutputArray  ' Display FullOutputArray to destination sheet
'
'---------------------------------------------------------------------------------------------------------------
'
' Convert FullOutputArray to a condensed 1 column array padded with spaces for nicer viewing in the text file
    ReDim OutputArrayForTxtFile(1 To UBound(FullOutputArray, 1), 1 To 1)                                        ' Establish size of OutputArrayForTxtFile
'
    For ArrayColumn = 1 To UBound(FullOutputArray, 2)                                                           ' Loop through the columns of FullOutputArray
        MaxCellLength = 0                                                                                       '   Initialize MaxCellLength
'
        For ArrayRow = 1 To UBound(FullOutputArray, 1)                                                          '   Loop through the rows of FullOutputArray
            If MaxCellLength < Len(FullOutputArray(ArrayRow, ArrayColumn)) Then _
                    MaxCellLength = Len(FullOutputArray(ArrayRow, ArrayColumn))                                 '       Save largest character count of the cell values
        Next                                                                                                    '   Loop back
'
        For ArrayRow = 1 To UBound(FullOutputArray, 1)                                                          '   Loop through the rows of FullOutputArray
            If OutputArrayForTxtFile(ArrayRow, 1) <> "" Then                                                    '       If this is not the first column of FullOutputArray then ...
                OutputArrayForTxtFile(ArrayRow, 1) = OutputArrayForTxtFile(ArrayRow, 1) & _
                        FullOutputArray(ArrayRow, ArrayColumn) & Space(MaxCellLength - _
                        Len(FullOutputArray(ArrayRow, ArrayColumn)))                                            '           Make all of the character counts the same by adding any spaces needed
'                                                                                                               '                   then add it to previous column results
            Else                                                                                                '       Else ...
                OutputArrayForTxtFile(ArrayRow, 1) = FullOutputArray(ArrayRow, ArrayColumn) & _
                        Space(MaxCellLength - Len(FullOutputArray(ArrayRow, ArrayColumn)))                      '           Make all of the character counts the same by adding any spaces needed
            End If
        Next                                                                                                    '   Loop back
    Next                                                                                                        ' Loop back
'
'---------------------------------------------------------------------------------------------------------------
'
' Display OutputArrayForTxtFile to sheet, copy it, write it to text file, delete it from sheet
    LastColumnNumberUsedInSheet = DestinationWS.Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column ' Get LastColumnNumberUsedInSheet
'
    With DestinationWS
        .Cells(1, LastColumnNumberUsedInSheet + 1).Resize(UBound(OutputArrayForTxtFile, 1)) = OutputArrayForTxtFile ' Display OutputArrayForTxtFile to destination sheet
'
        If NotFirstWrite = True Then                                                                            '   If this isn't the first write to the text file then ...
            DestinationWS.Cells(1, LastColumnNumberUsedInSheet + 1).Delete Shift:=xlUp                          '       delete the header row from results
        Else                                                                                                    '   Else ...
            NotFirstWrite = True                                                                                '       Set NotFirstWrite to True for future writes to text file
        End If
'
        .Cells(1, LastColumnNumberUsedInSheet + 1).Resize(UBound(OutputArrayForTxtFile, 1)).Copy                ' Copy data needed for .txt file to clipboard
    End With
'
    strData = CreateObject("htmlfile").ParentWindow.ClipboardData.GetData("Text")                               ' Save contents of clipboard into strData
'
'
'    CreateObject("Scripting.FileSystemObject").CreateTextFile(strTempFile, True).Write strData                  ' Write the data to file, overwrite data if file already exists
    CreateObject("Scripting.FileSystemObject").OpenTextFile(strTempFile, 8, True, 0).Write strData              ' Write the data to file, append data if file already exists
'
    DestinationWS.Cells(1, LastColumnNumberUsedInSheet + 1).Resize(UBound(OutputArrayForTxtFile, 1)).Clear      ' Erase the data used for the .txt file from the destination sheet
'
'---------------------------------------------------------------------------------------------------------------
'
    ReDim FullOutputArray(1 To 16384, 1 To UBound(IP_RangesArray, 2))                                           ' Erase & establish size of FullOutputArray
'
    For ArrayColumn = 1 To UBound(IP_RangesArray, 2)                                                            ' Loop through columns of IP_RangesArray
        FullOutputArray(1, ArrayColumn) = IP_RangesArray(1, ArrayColumn) & "          "                         '   Copy the Header to FullOutputArray
    Next                                                                                                        ' Loop back
'
    IP_AddressRow = 1                                                                                           ' Reset the IP_AddressRow
End Sub


Sub SequenceIP_AddressRange_Vertical(LowerIP_Address As String, UpperIP_Address As String)
'
    Dim b                       As Boolean
    Dim OctetNumber             As Long
    Dim LowerIP_OctetsArray()   As String
    Dim UpperIP_OctetsArray()   As String
'
    LowerIP_OctetsArray = Split(LowerIP_Address, ".")                                                           ' Split the LowerIP_Address into octets according to '.' found
    UpperIP_OctetsArray = Split(UpperIP_Address, ".")                                                           ' Split the UpperIP_Address into octets according to '.' found
'
    b = True                                                                                                    ' Set boolean flag b to True, this line may not be required
'
    Do Until Join(LowerIP_OctetsArray, ".") = Join(UpperIP_OctetsArray, ".")                                    ' Loop until LowerIP_Address = UpperIP_Address
        b = True                                                                                                '   Set boolean flag b to true
'
        For OctetNumber = 1 To 3                                                                                '   Loop
            If LowerIP_OctetsArray(OctetNumber) = 256 Then                                                      '       If OctetNumber value = 256 then ...
                LowerIP_OctetsArray(OctetNumber - 1) = LowerIP_OctetsArray(OctetNumber - 1) + 1                 '           Increment the next higher OctetNumber value
                LowerIP_OctetsArray(OctetNumber) = 0                                                            '           Set OctetNumber value to zero
'
                b = False                                                                                       '           Set boolean flag b to False
            End If
        Next                                                                                                    '   Loop back
'
        IP_AddressRow = IP_AddressRow + 1                                                                       '   Increment IP_AddressRow
        FullOutputArray(IP_AddressRow, 1) = IP_RangesArray(IP_RangesArrayRow, 1)                                '   Save Owner to FullOutputArray
        FullOutputArray(IP_AddressRow, 2) = IP_RangesArray(IP_RangesArrayRow, 2)                                '   Save Active to FullOutputArray
        FullOutputArray(IP_AddressRow, 3) = IP_RangesArray(IP_RangesArrayRow, 3)                                '   Save Group to FullOutputArray
        FullOutputArray(IP_AddressRow, 4) = Join(LowerIP_OctetsArray, ".")                                      '   Save IP address to FullOutputArray
        FullOutputArray(IP_AddressRow, 5) = Format(IP_RangesArray(IP_RangesArrayRow, 5), "m/d/yyyy")            '   Save exp to FullOutputArray
'
        If b Then LowerIP_OctetsArray(3) = LowerIP_OctetsArray(3) + 1                                           '   Increment Octet 1 value
'
        If IP_AddressRow = MaxRowsToPrint Then Call WriteToTextFile                                             '   If we have reached the MaxRowsToPrint then write results to file
    Loop                                                                                                        ' Loop back
'
    IP_AddressRow = IP_AddressRow + 1                                                                           ' Increment IP_AddressRow
    FullOutputArray(IP_AddressRow, 1) = IP_RangesArray(IP_RangesArrayRow, 1)                                    ' Save Owner to FullOutputArray
    FullOutputArray(IP_AddressRow, 2) = IP_RangesArray(IP_RangesArrayRow, 2)                                    ' Save Active to FullOutputArray
    FullOutputArray(IP_AddressRow, 3) = IP_RangesArray(IP_RangesArrayRow, 3)                                    ' Save Group to FullOutputArray
    FullOutputArray(IP_AddressRow, 4) = Join(LowerIP_OctetsArray, ".")                                          ' Save IP address to FullOutputArray
    FullOutputArray(IP_AddressRow, 5) = Format(IP_RangesArray(IP_RangesArrayRow, 5), "m/d/yyyy")                ' Save exp to FullOutputArray
'
    If IP_AddressRow = MaxRowsToPrint Then Call WriteToTextFile                                                 ' If we have reached the MaxRowsToPrint then write results to file
End Sub

 

[johnnyL]

Update:
@Akuini is who I saw post the code for padding a text file with spaces. Just wanted to give credit for who I got the idea from originally.