Expand IP Ranges

D

Danny54

Active Member
Joined
Jul 3, 2019
Messages
295
Office Version
  1. 365
Platform
  1. Windows
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

owneractivegroupaddressexp
a
1​
gray10.10.10.10
1/1/2023​
b
1​
blue10.10.10.12-10.10.10.15
1/1/2023​
c
1​
red10.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

owneractivegroupaddressexp
a
1​
gray10.10.10.10
1/1/2023​
b
1​
blue10.10.10.12
1/1/2023​
b
1​
blue10.10.10.13
1/1/2023​
b
1​
blue10.10.10.14
1/1/2023​
b
1​
blue10.10.10.15
1/1/2023​
c
1​
red10.10.10.20
1/1/2023​
c
1​
red10.10.10.21
1/1/2023​
c
1​
red10.10.10.22
1/1/2023​
c
1​
red10.10.10.23
1/1/2023​
c
1​
red10.10.10.24
1/1/2023​
c
1​
red10.10.10.25
1/1/2023​
c
1​
red192.168.1.1
1/1/2023​
c
1​
red192.168.1.2
1/1/2023​
c
1​
red192.168.10.10
1/1/2023​

Thanks
 
Sort by date Sort by votes
Wow,
thanks for all your hard work (unbelievable). I wouldn't have figured it out. I tested the code and it works perfectly for test data i provided.
Since my data (rows) is much larger would it be possible to modify the macro to read a process flag for each line?
Say I insert a new column (column A) called process and if I want to process that row I will insert a 1 else it will have a 0.
This way I can take my original data, insert a column with a 1 or 0. If 1 is found, process the expand, else do nothing and move to the next row.

Again, thanks so so much

processowneractivegroupaddressexp
1​
a
1​
gray10.10.10.10
1/1/2023​
0​
b
1​
blue10.10.10.12-10.10.10.15
1/1/2023​
1​
c
1​
red10.10.10.20-10.10.10.25, 192.168.1.1-192.168.1.2,192.168.10.10
1/1/2023​
 
Upvote 0

Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.
How about:

VBA Code: 
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_VerticalV4()
'
    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("E:E").Replace " ", "", xlPart                                                             ' Remove all spacea from IP ranges in column E
'
    NotFirstWrite = False                                                                                       ' Set NotFirstWrite to False to indicate the FirstWrite will occur
'
    IP_RangesArray = SourceWS.Range("A1:F" & SourceWS.Range("E" & 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 = 2 To UBound(IP_RangesArray, 2)                                                            ' Loop through columns of IP_RangesArray
        FullOutputArray(1, ArrayColumn - 1) = 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 IP_RangesArray(IP_RangesArrayRow, 1) <> 0 Then                                                       '
            If InStr(IP_RangesArray(IP_RangesArrayRow, 5), "-") > 0 Then                                        '   If the row contains '-' then ... IP range needs to be expanded
                IP_AddressesToExpandArray = Split(IP_RangesArray(IP_RangesArrayRow, 5), ",")                    '       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, 2)                '               Save Owner to FullOutputArray
                        FullOutputArray(IP_AddressRow, 2) = IP_RangesArray(IP_RangesArrayRow, 3)                '               Save Active to FullOutputArray
                        FullOutputArray(IP_AddressRow, 3) = IP_RangesArray(IP_RangesArrayRow, 4)                '               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, 6), "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, 2)                        '       Save Owner to FullOutputArray
                FullOutputArray(IP_AddressRow, 2) = IP_RangesArray(IP_RangesArrayRow, 3)                        '       Save Active to FullOutputArray
                FullOutputArray(IP_AddressRow, 3) = IP_RangesArray(IP_RangesArrayRow, 4)                        '       Save Group to FullOutputArray
                FullOutputArray(IP_AddressRow, 4) = IP_RangesArray(IP_RangesArrayRow, 5)                        '       Save IP address to FullOutputArray
                FullOutputArray(IP_AddressRow, 5) = Format(IP_RangesArray(IP_RangesArrayRow, 6), "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
        End If
    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 = 2 To UBound(IP_RangesArray, 2)                                                            ' Loop through columns of IP_RangesArray
        FullOutputArray(1, ArrayColumn - 1) = 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, 2)                                '   Save Owner to FullOutputArray
        FullOutputArray(IP_AddressRow, 2) = IP_RangesArray(IP_RangesArrayRow, 3)                                '   Save Active to FullOutputArray
        FullOutputArray(IP_AddressRow, 3) = IP_RangesArray(IP_RangesArrayRow, 4)                                '   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, 6), "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, 2)                                    ' Save Owner to FullOutputArray
    FullOutputArray(IP_AddressRow, 2) = IP_RangesArray(IP_RangesArrayRow, 3)                                    ' Save Active to FullOutputArray
    FullOutputArray(IP_AddressRow, 3) = IP_RangesArray(IP_RangesArrayRow, 4)                                    ' 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, 6), "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
 
Upvote 0
Thank you.

Did the code above read the test data below? I was hoping that the macro would perhaps filter on column "process" and process only the filtered "1".
So, the output from the test file should only show the 1st and 3rd rows of output data in the text file. Nothing from row 2.
Sorry I didn't explain better.




processowneractivegroupaddressexp
1a1gray10.10.10.101/1/2023
0b1blue10.10.10.12-10.10.10.151/1/2023
1c1red10.10.10.20-10.10.10.25, 192.168.1.1-192.168.1.2,192.168.10.101/1/2023
 
Upvote 0
Did you test it or look at the code?

I found a few other things that need to be addressed, but the answer to your question is Yes.
 
Upvote 0
Yes, I went thru the code line by line and tested it. I somehow didnt understand what it actually was doing. So now I tested by filtering out all the "1"s and running it, I got the results that was needed.
Then I went back thru and unfiltered the process column and ran again "Super", it only selected the rows with a 1. Same as filtered. Tomorrow I will run using the large file.

Again, I really appreciate your help and what a lot of examples snippets to use in other macros.

Thanks
 
Upvote 0
After your last post I was going to say that you don't need to do any filtering, then I see you later said you tried it without the filtering and it worked.

Yes, the code does the 'filtering' for you. It checks the value in Column A of each row, if it encounters a zero value, it skips that row and proceeds to the next row. Any other value found in column A, that row will be processed. Basically, you only need to put a zero in the rows you want skipped, anything else will be processed. In other words, you only have to put the zeros in the rows that you want to skip, nothing else in the other rows, unless you want to. Think of the zero as a 'checkmark' to skip that row.

I am currently working on the writing to the text file, more specifically, the current code opens the file on every write to it. That gets more expensive, time wise, the larger the text file gets. I think that issue has been solved. I changed up how that process works,

The other thing I noticed is that the incrementing of the IP octets has a flaw. I think I have that resolved as well, I just need to create a few ranges to test.

About the Range of IPs of 10.0.0.0-10.255.255.255 ... I have semi tested that also. I am guesstimating that the resulting file would be over 1GB in size & take over 5 hrs to complete. :eek: Hopefully you don't encounter such a wide range in your testing.

I will wrap up my newest fixes & post that code for you to test.
 
Upvote 0
johnnyL said:
Basically, you only need to put a zero in the rows you want skipped, anything else will be processed. In other words, you only have to put the zeros in the rows that you want to skip, nothing else in the other rows, unless you want to. Think of the zero as a 'checkmark' to skip that row.
Click to expand...

That update will be included in the next code I post. :)
 
Upvote 0
Ok here is the data I used for testing the previous V4 version:

Sequence IP Address Ranges.xlsm
ABCDEFG
1ProcessOwnerActiveGroupaddressexp
21A1gray10.10.10.254-10.10.11.11/1/2023
31B1blue10.10.255.254-10.11.0.11/2/2023
41C1red10.255.255.254-11.0.0.11/3/2023
51D1green255.255.255.254-256.0.0.111/22/2022
6
Sheet1



Results:
Sequence IP Address Ranges.xlsm
ABC
1Owner Active Group address exp
2A 1 gray 10.10.10.254 1/1/2023
3A 1 gray 10.10.10.255 1/1/2023
4A 1 gray 10.10.11.0 1/1/2023
5A 1 gray 10.10.11.0 1/1/2023 <-- Repeat Value
6A 1 gray 10.10.11.1 1/1/2023
7B 1 blue 10.10.255.254 1/2/2023
8B 1 blue 10.10.255.255 1/2/2023
9B 1 blue 10.10.256.0 1/2/2023 <-- Incorrect Value
10B 1 blue 10.11.0.0 1/2/2023
11B 1 blue 10.11.0.0 1/2/2023 <-- Repeat Value
12B 1 blue 10.11.0.1 1/2/2023
13C 1 red 10.255.255.254 1/3/2023
14C 1 red 10.255.255.255 1/3/2023
15C 1 red 10.255.256.0 1/3/2023 <-- Incorrect Value
16C 1 red 10.256.0.0 1/3/2023 <-- Incorrect Value
17C 1 red 11.0.0.0 1/3/2023
18C 1 red 11.0.0.0 1/3/2023 <-- Repeat Value
19C 1 red 11.0.0.1 1/3/2023
20D 1 green 255.255.255.254 11/22/2022
21D 1 green 255.255.255.255 11/22/2022
22D 1 green 255.255.256.0 11/22/2022 <-- Incorrect Value
23D 1 green 255.256.0.0 11/22/2022 <-- Incorrect Value
24D 1 green 256.0.0.0 11/22/2022 <-- Incorrect Value
25D 1 green 256.0.0.0 11/22/2022 <-- Repeat of Incorrect Value
26D 1 green 256.0.0.1 11/22/2022 <-- Incorrect Value
27
V4 Results WithIncorrect Values

As you can see, there are numerous problems with those /\ /\ /\ /\ results.



Results from the updated code V5 that will be posted after these results:
Sequence IP Address Ranges.xlsm
AB
1Owner Active Group address exp
2A 1 gray 10.10.10.254 1/1/2023
3A 1 gray 10.10.10.255 1/1/2023
4A 1 gray 10.10.11.0 1/1/2023
5A 1 gray 10.10.11.1 1/1/2023
6B 1 blue 10.10.255.254 1/2/2023
7B 1 blue 10.10.255.255 1/2/2023
8B 1 blue 10.11.0.0 1/2/2023
9B 1 blue 10.11.0.1 1/2/2023
10C 1 red 10.255.255.254 1/3/2023
11C 1 red 10.255.255.255 1/3/2023
12C 1 red 11.0.0.0 1/3/2023
13C 1 red 11.0.0.1 1/3/2023
14D 1 green 255.255.255.254 11/22/2022
15D 1 green 255.255.255.255 11/22/2022
16
V5 Results


I haven't incorcorporated the code to allow blanks in column A yet so stick with the 1's and 0's in column A.
Updated V5 code:
VBA Code: 
Option Explicit
'
    Const ForAppending = 8
    Const TristateFalse = 0
'
    Dim NotFirstWrite       As Boolean
    Dim IP_AddressRow       As Long
    Dim IP_RangesArrayRow   As Long
    Dim MaxRowsToPrint      As Long
    Dim TotalRows           As Long
    Dim FSO                 As Object, TS As Object
    Dim strTempFile         As String
    Dim IP_RangesArray()    As Variant
    Dim FullOutputArray()   As Variant
    Dim DestinationWS       As Worksheet

Sub ExpandIPs_VerticalV5()
'
Dim StartTime                   As Double
StartTime = Timer
'
    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 = 16000                                                                                      ' <--- 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("E:E").Replace " ", "", xlPart                                                             ' Remove all spacea from IP ranges in column E
'
    NotFirstWrite = False                                                                                       ' Set NotFirstWrite to False to indicate the FirstWrite will occur
'
    IP_RangesArray = SourceWS.Range("A1:F" & SourceWS.Range("E" & 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
'
    Set FSO = CreateObject("Scripting.FileSystemObject")                                                        '
'
    Set TS = FSO.OpenTextFile(strTempFile, ForAppending, True, TristateFalse)                                   ' Open the text file we will be writing to
'
'---------------------------------------------------------------------------------------------------------------
'
    For ArrayColumn = 2 To UBound(IP_RangesArray, 2)                                                            ' Loop through columns of IP_RangesArray
        FullOutputArray(1, ArrayColumn - 1) = IP_RangesArray(1, ArrayColumn) & "          "                     '   Copy the Header to FullOutputArray
    Next                                                                                                        ' Loop back
'
    IP_AddressRow = 1                                                                                           ' Initialize the IP_AddressRow
    TotalRows = 0                                                                                               ' Initialize TotalRows
'
    For IP_RangesArrayRow = 2 To UBound(IP_RangesArray, 1)                                                      ' Loop through rows of IP_RangesArray
        If IP_RangesArray(IP_RangesArrayRow, 1) <> 0 Then                                                       '
            If InStr(IP_RangesArray(IP_RangesArrayRow, 5), "-") > 0 Then                                        '   If the row contains '-' then ... IP range needs to be expanded
                IP_AddressesToExpandArray = Split(IP_RangesArray(IP_RangesArrayRow, 5), ",")                    '       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 ...
                        TotalRows = TotalRows + 1                                                               '               Increment TotalRows
                        IP_AddressRow = IP_AddressRow + 1                                                       '               Increment IP_AddressRow
                        FullOutputArray(IP_AddressRow, 1) = IP_RangesArray(IP_RangesArrayRow, 2)                '               Save Owner to FullOutputArray
                        FullOutputArray(IP_AddressRow, 2) = IP_RangesArray(IP_RangesArrayRow, 3)                '               Save Active to FullOutputArray
                        FullOutputArray(IP_AddressRow, 3) = IP_RangesArray(IP_RangesArrayRow, 4)                '               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, 6), "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
                TotalRows = TotalRows + 1                                                                       '       Increment TotalRows
                IP_AddressRow = IP_AddressRow + 1                                                               '       Increment IP_AddressRow
                FullOutputArray(IP_AddressRow, 1) = IP_RangesArray(IP_RangesArrayRow, 2)                        '       Save Owner to FullOutputArray
                FullOutputArray(IP_AddressRow, 2) = IP_RangesArray(IP_RangesArrayRow, 3)                        '       Save Active to FullOutputArray
                FullOutputArray(IP_AddressRow, 3) = IP_RangesArray(IP_RangesArrayRow, 4)                        '       Save Group to FullOutputArray
                FullOutputArray(IP_AddressRow, 4) = IP_RangesArray(IP_RangesArrayRow, 5)                        '       Save IP address to FullOutputArray
                FullOutputArray(IP_AddressRow, 5) = Format(IP_RangesArray(IP_RangesArrayRow, 6), "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
         End If
    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
'
    TS.Close                                                                                                    ' Close the text file
'
    Application.ScreenUpdating = True                                                                           ' Turn ScreenUpdating back on
'
Debug.Print "Completion Time for " & TotalRows & " rows = " & Timer - StartTime & " seconds."                   ' Display time to complete to the 'Immediate' window (CTRL+G) in VBE
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
'
    TS.Write strData                                                                                            ' Write the data to the text file
'
    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 = 2 To UBound(IP_RangesArray, 2)                                                            ' Loop through columns of IP_RangesArray
        FullOutputArray(1, ArrayColumn - 1) = 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
'
    Do Until Join(LowerIP_OctetsArray, ".") = Join(UpperIP_OctetsArray, ".")                                    ' Loop until LowerIP_Address = UpperIP_Address
        If LowerIP_OctetsArray(3) = 256 Then                                                                    '   If the last OctetNumber value = 256 then ...
            LowerIP_OctetsArray(3) = 0                                                                          '       Set OctetNumber value to zero
            LowerIP_OctetsArray(2) = LowerIP_OctetsArray(2) + 1                                                 '       Increment the second to last OctetNumber value
'
            If LowerIP_OctetsArray(2) = 256 Then                                                                '       If the second to last OctetNumber value = 256 then ...
                LowerIP_OctetsArray(2) = 0                                                                      '           Set OctetNumber value to zero
                LowerIP_OctetsArray(1) = LowerIP_OctetsArray(1) + 1                                             '           Increment the third to last OctetNumber value
'
                If LowerIP_OctetsArray(1) = 256 Then                                                            '           If the third to last OctetNumber value = 256 then ...
                    LowerIP_OctetsArray(1) = 0                                                                  '               Set OctetNumber value to zero
                    LowerIP_OctetsArray(0) = LowerIP_OctetsArray(0) + 1                                         '               Increment the fourth to last OctetNumber value
'
                    If LowerIP_OctetsArray(0) = 256 Then Exit Sub                                               '               If the first OctetNumber value = 256 then exit this sub
                End If
            End If
        End If
'
        TotalRows = TotalRows + 1                                                                               '   Increment TotalRows
        IP_AddressRow = IP_AddressRow + 1                                                                       '   Increment IP_AddressRow
        FullOutputArray(IP_AddressRow, 1) = IP_RangesArray(IP_RangesArrayRow, 2)                                '   Save Owner to FullOutputArray
        FullOutputArray(IP_AddressRow, 2) = IP_RangesArray(IP_RangesArrayRow, 3)                                '   Save Active to FullOutputArray
        FullOutputArray(IP_AddressRow, 3) = IP_RangesArray(IP_RangesArrayRow, 4)                                '   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, 6), "m/d/yyyy")            '   Save exp to FullOutputArray
'
        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
'
    TotalRows = TotalRows + 1                                                                                   ' Increment TotalRows
    IP_AddressRow = IP_AddressRow + 1                                                                           ' Increment IP_AddressRow
    FullOutputArray(IP_AddressRow, 1) = IP_RangesArray(IP_RangesArrayRow, 2)                                    ' Save Owner to FullOutputArray
    FullOutputArray(IP_AddressRow, 2) = IP_RangesArray(IP_RangesArrayRow, 3)                                    ' Save Active to FullOutputArray
    FullOutputArray(IP_AddressRow, 3) = IP_RangesArray(IP_RangesArrayRow, 4)                                    ' 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, 6), "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
 
Last edited:
Upvote 0
johnnyL said:
I haven't incorcorporated the code to allow blanks in column A yet so stick with the 1's and 0's in column A.
Click to expand...
Ok I figured out the problem. A zero value in an array is equivalent to a cell that has nothing in it. Both equate to zero.

This means you can't use zero to skip a row unless you want to put something in all of the other cells in that column.

Simple solution:
Use an 'x' instead to skip rows. It can be lower or uppercase. This way you won't have to make an entry in every cell of the column A, just put an 'x' in the rows that you want to skip.

Example:
Sequence IP Address Ranges.xlsm
ABCDEFG
1ProcessOwnerActiveGroupaddressexp
2A1gray10.10.10.254-10.10.11.11/1/2023
3B1blue10.10.255.254-10.11.0.11/2/2023
4XC1red10.255.255.254-11.0.0.11/3/2023
5D1green255.255.255.254-256.0.0.111/22/2022
6
Sheet1



Updated version 5x:

VBA Code: 
Option Explicit
'
    Const ForAppending = 8
    Const TristateFalse = 0
'
    Dim NotFirstWrite       As Boolean
    Dim IP_AddressRow       As Long
    Dim IP_RangesArrayRow   As Long
    Dim MaxRowsToPrint      As Long
    Dim TotalRows           As Long
    Dim FSO                 As Object, TS As Object
    Dim strTempFile         As String
    Dim IP_RangesArray()    As Variant
    Dim FullOutputArray()   As Variant
    Dim DestinationWS       As Worksheet

Sub ExpandIPs_VerticalV5_x()
'
Dim StartTime                   As Double
StartTime = Timer
'
    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 = 16000                                                                                      ' <--- 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("E:E").Replace " ", "", xlPart                                                             ' Remove all spacea from IP ranges in column E
'
    NotFirstWrite = False                                                                                       ' Set NotFirstWrite to False to indicate the FirstWrite will occur
'
    IP_RangesArray = SourceWS.Range("A1:F" & SourceWS.Range("E" & 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
'
    Set FSO = CreateObject("Scripting.FileSystemObject")                                                        '
'
    Set TS = FSO.OpenTextFile(strTempFile, ForAppending, True, TristateFalse)                                   ' Open the text file we will be writing to
'
'---------------------------------------------------------------------------------------------------------------
'
    For ArrayColumn = 2 To UBound(IP_RangesArray, 2)                                                            ' Loop through columns of IP_RangesArray
        FullOutputArray(1, ArrayColumn - 1) = IP_RangesArray(1, ArrayColumn) & "          "                     '   Copy the Header to FullOutputArray
    Next                                                                                                        ' Loop back
'
    IP_AddressRow = 1                                                                                           ' Initialize the IP_AddressRow
    TotalRows = 0                                                                                               ' Initialize TotalRows
'
    For IP_RangesArrayRow = 2 To UBound(IP_RangesArray, 1)                                                      ' Loop through rows of IP_RangesArray
        If LCase(IP_RangesArray(IP_RangesArrayRow, 1)) <> "x" Then                                              '   If 'x' is found in column A then skip that row
            If InStr(IP_RangesArray(IP_RangesArrayRow, 5), "-") > 0 Then                                        '   If the IP address column contains '-' then ... IP range needs to be expanded
                IP_AddressesToExpandArray = Split(IP_RangesArray(IP_RangesArrayRow, 5), ",")                    '       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 ...
                        TotalRows = TotalRows + 1                                                               '               Increment TotalRows
                        IP_AddressRow = IP_AddressRow + 1                                                       '               Increment IP_AddressRow
                        FullOutputArray(IP_AddressRow, 1) = IP_RangesArray(IP_RangesArrayRow, 2)                '               Save Owner to FullOutputArray
                        FullOutputArray(IP_AddressRow, 2) = IP_RangesArray(IP_RangesArrayRow, 3)                '               Save Active to FullOutputArray
                        FullOutputArray(IP_AddressRow, 3) = IP_RangesArray(IP_RangesArrayRow, 4)                '               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, 6), "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
                TotalRows = TotalRows + 1                                                                       '       Increment TotalRows
                IP_AddressRow = IP_AddressRow + 1                                                               '       Increment IP_AddressRow
                FullOutputArray(IP_AddressRow, 1) = IP_RangesArray(IP_RangesArrayRow, 2)                        '       Save Owner to FullOutputArray
                FullOutputArray(IP_AddressRow, 2) = IP_RangesArray(IP_RangesArrayRow, 3)                        '       Save Active to FullOutputArray
                FullOutputArray(IP_AddressRow, 3) = IP_RangesArray(IP_RangesArrayRow, 4)                        '       Save Group to FullOutputArray
                FullOutputArray(IP_AddressRow, 4) = IP_RangesArray(IP_RangesArrayRow, 5)                        '       Save IP address to FullOutputArray
                FullOutputArray(IP_AddressRow, 5) = Format(IP_RangesArray(IP_RangesArrayRow, 6), "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
         End If
    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
'
    TS.Close                                                                                                    ' Close the text file
'
    Application.ScreenUpdating = True                                                                           ' Turn ScreenUpdating back on
'
Debug.Print "Completion Time for " & TotalRows & " rows = " & Timer - StartTime & " seconds."                   ' Display time to complete to the 'Immediate' window (CTRL+G) in VBE
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
'
    TS.Write strData                                                                                            ' Write the data to the text file
'
    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 = 2 To UBound(IP_RangesArray, 2)                                                            ' Loop through columns of IP_RangesArray
        FullOutputArray(1, ArrayColumn - 1) = 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
'
    Do Until Join(LowerIP_OctetsArray, ".") = Join(UpperIP_OctetsArray, ".")                                    ' Loop until LowerIP_Address = UpperIP_Address
        If LowerIP_OctetsArray(3) = 256 Then                                                                    '   If the last OctetNumber value = 256 then ...
            LowerIP_OctetsArray(3) = 0                                                                          '       Set OctetNumber value to zero
            LowerIP_OctetsArray(2) = LowerIP_OctetsArray(2) + 1                                                 '       Increment the second to last OctetNumber value
'
            If LowerIP_OctetsArray(2) = 256 Then                                                                '       If the second to last OctetNumber value = 256 then ...
                LowerIP_OctetsArray(2) = 0                                                                      '           Set OctetNumber value to zero
                LowerIP_OctetsArray(1) = LowerIP_OctetsArray(1) + 1                                             '           Increment the third to last OctetNumber value
'
                If LowerIP_OctetsArray(1) = 256 Then                                                            '           If the third to last OctetNumber value = 256 then ...
                    LowerIP_OctetsArray(1) = 0                                                                  '               Set OctetNumber value to zero
                    LowerIP_OctetsArray(0) = LowerIP_OctetsArray(0) + 1                                         '               Increment the fourth to last OctetNumber value
'
                    If LowerIP_OctetsArray(0) = 256 Then Exit Sub                                               '               If the first OctetNumber value = 256 then exit this sub
                End If
            End If
        End If
'
        TotalRows = TotalRows + 1                                                                               '   Increment TotalRows
        IP_AddressRow = IP_AddressRow + 1                                                                       '   Increment IP_AddressRow
        FullOutputArray(IP_AddressRow, 1) = IP_RangesArray(IP_RangesArrayRow, 2)                                '   Save Owner to FullOutputArray
        FullOutputArray(IP_AddressRow, 2) = IP_RangesArray(IP_RangesArrayRow, 3)                                '   Save Active to FullOutputArray
        FullOutputArray(IP_AddressRow, 3) = IP_RangesArray(IP_RangesArrayRow, 4)                                '   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, 6), "m/d/yyyy")            '   Save exp to FullOutputArray
'
        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
'
    TotalRows = TotalRows + 1                                                                                   ' Increment TotalRows
    IP_AddressRow = IP_AddressRow + 1                                                                           ' Increment IP_AddressRow
    FullOutputArray(IP_AddressRow, 1) = IP_RangesArray(IP_RangesArrayRow, 2)                                    ' Save Owner to FullOutputArray
    FullOutputArray(IP_AddressRow, 2) = IP_RangesArray(IP_RangesArrayRow, 3)                                    ' Save Active to FullOutputArray
    FullOutputArray(IP_AddressRow, 3) = IP_RangesArray(IP_RangesArrayRow, 4)                                    ' 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, 6), "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
 
Upvote 0
Solution
Thanks so, so much. I just validated version 5x and everything looks "Great". When I first did the ask I didn't think the solution would be so big. You really went all out and I really
appreciate it. As I said before there is so much hear that I can learn from. Appreciate you kindness

Have a Happy Holiday

Thank you!!!!!
 
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Solved
Expanding IP ranges thru 3 octets
2
Replies
10
Views
1K
Danny54
D

Forum statistics

Threads
1,216,027
Messages
6,128,377
Members
449,445
Latest member
JJFabEngineering

Share this page

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