addistexan
New Member
- Joined
- Oct 30, 2023
- Messages
- 8
- Office Version
- 365
- Platform
- Windows
Hello,
I've been trying to figure out how easily filter out IP addresses based on their first 2 octets. By using this platform and tweeking a formula, I was able to filter out IP addresses with an exact match. However, there are so many IP addresses in each range that I think it makes more sense to filter based on the first 2 octets instead. My original formula that works for match on full IP address is: =LET(x,FILTERXML("<x><y>"&SUBSTITUTE(A5,", ","</y><y>")&"</y></x>","//y"),TEXTJOIN(" ",1,FILTER(x,ISERROR(MATCH(x,FILTERXML("<x><y>"&SUBSTITUTE(TEXTJOIN(" ",1,CloudflareIP)," ","</y><y>")&"</y> </x>","//y"),0)),"")))
To make it more complicated, some cells have 1 IP address, and some may have up to 200 IP addresses in a single cell, all seperated by commas.
Now I've been trying to use a macro to look at each cell in my range (A1:A3000) in worksheet1, take each IP address, read the first 2 octets (e.g., 123.123.) and compare that to my list in worksheet2. I there is a match, I want the entire IP address from worksheet1 deleted, otherwise, go to the next. By the end, I want each cell to contain all the IP addresses is started with (with the matched ones removed), and all separated by a comma. Here are a couple of my attempts:
Sub FilterIPAddress1()
Dim Cell As Range
Dim cell2 As Range
Dim SearchRange As Range
Dim IPAddress As String
Dim OctetsSearchRange As Range
Dim OctetsToMatch As String
' OctetsToMatch = "" ' Replace with your desired first 2 octets
' Define the range to search for IP addresses (change this to match your actual range)
Set SearchRange = Worksheets("Sheet1").Range("A1:A3000")
'Define the range where Octets to search will be kept
Set OctetsSearchRange = Worksheets("Sheet2").Range("A1:D5000")
' Loop through each cell in worksheet 1
For Each Cell In SearchRange
If Cell.Value <> "" Then
' Extract the IP address in the first 2 octets
IPAddress = Left(Cell.Value, InStr(Cell.Value, ".") - 1)
' Loop through each Octet in worksheet 2
For Each cell2 In OctetsSearchRange
' Check if the Octet in Worksheet 1 matches an Octet in Worksheet 2
If IPAddress = OctetsToMatch Then
' If it matches, delete the entire IP address
Cell.ClearContents
End If
End If
Next Cell
End Sub
And another:
Sub FilterIPAddresses2()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim cell1 As Range
Dim cell2 As Range
Dim sentence As String
Dim ipParts() As String
Dim ipPart As Variant
Dim firstTwoOctets As String
Dim opticsToDelete As String
' Set the worksheets you want to work with
Set ws1 = ThisWorkbook.Worksheets("Sheet1") ' Change "Sheet1" to your first worksheet name
Set ws2 = ThisWorkbook.Worksheets("Sheet2") ' Change "Sheet2" to your second worksheet name
' Loop through each cell in the first worksheet
For Each cell1 In ws1.UsedRange
sentence = cell1.Value
opticsToDelete = ""
' Split the sentence into individual IP addresses based on commas
ipParts = Split(sentence, ",")
' Loop through each IP address
For Each ipPart In ipParts
' Extract the first two octets
firstTwoOctets = Left(ipPart, InStr(ipPart, ".", InStr(ipPart, ".") + 1) - 1)
' Check if the firstTwoOctets exist in the second worksheet
If WorksheetFunction.CountIf(ws2.UsedRange, firstTwoOctets) > 0 Then
' If it exists, add the entire IP address to the list to delete
opticsToDelete = opticsToDelete & ipPart & ","
End If
Next ipPart
Of course I'm not getting proper reults or errors and I am way beyond my ability. Thank you for any suggestions or assistance!
I've been trying to figure out how easily filter out IP addresses based on their first 2 octets. By using this platform and tweeking a formula, I was able to filter out IP addresses with an exact match. However, there are so many IP addresses in each range that I think it makes more sense to filter based on the first 2 octets instead. My original formula that works for match on full IP address is: =LET(x,FILTERXML("<x><y>"&SUBSTITUTE(A5,", ","</y><y>")&"</y></x>","//y"),TEXTJOIN(" ",1,FILTER(x,ISERROR(MATCH(x,FILTERXML("<x><y>"&SUBSTITUTE(TEXTJOIN(" ",1,CloudflareIP)," ","</y><y>")&"</y> </x>","//y"),0)),"")))
To make it more complicated, some cells have 1 IP address, and some may have up to 200 IP addresses in a single cell, all seperated by commas.
Now I've been trying to use a macro to look at each cell in my range (A1:A3000) in worksheet1, take each IP address, read the first 2 octets (e.g., 123.123.) and compare that to my list in worksheet2. I there is a match, I want the entire IP address from worksheet1 deleted, otherwise, go to the next. By the end, I want each cell to contain all the IP addresses is started with (with the matched ones removed), and all separated by a comma. Here are a couple of my attempts:
Sub FilterIPAddress1()
Dim Cell As Range
Dim cell2 As Range
Dim SearchRange As Range
Dim IPAddress As String
Dim OctetsSearchRange As Range
Dim OctetsToMatch As String
' OctetsToMatch = "" ' Replace with your desired first 2 octets
' Define the range to search for IP addresses (change this to match your actual range)
Set SearchRange = Worksheets("Sheet1").Range("A1:A3000")
'Define the range where Octets to search will be kept
Set OctetsSearchRange = Worksheets("Sheet2").Range("A1:D5000")
' Loop through each cell in worksheet 1
For Each Cell In SearchRange
If Cell.Value <> "" Then
' Extract the IP address in the first 2 octets
IPAddress = Left(Cell.Value, InStr(Cell.Value, ".") - 1)
' Loop through each Octet in worksheet 2
For Each cell2 In OctetsSearchRange
' Check if the Octet in Worksheet 1 matches an Octet in Worksheet 2
If IPAddress = OctetsToMatch Then
' If it matches, delete the entire IP address
Cell.ClearContents
End If
End If
Next Cell
End Sub
And another:
Sub FilterIPAddresses2()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim cell1 As Range
Dim cell2 As Range
Dim sentence As String
Dim ipParts() As String
Dim ipPart As Variant
Dim firstTwoOctets As String
Dim opticsToDelete As String
' Set the worksheets you want to work with
Set ws1 = ThisWorkbook.Worksheets("Sheet1") ' Change "Sheet1" to your first worksheet name
Set ws2 = ThisWorkbook.Worksheets("Sheet2") ' Change "Sheet2" to your second worksheet name
' Loop through each cell in the first worksheet
For Each cell1 In ws1.UsedRange
sentence = cell1.Value
opticsToDelete = ""
' Split the sentence into individual IP addresses based on commas
ipParts = Split(sentence, ",")
' Loop through each IP address
For Each ipPart In ipParts
' Extract the first two octets
firstTwoOctets = Left(ipPart, InStr(ipPart, ".", InStr(ipPart, ".") + 1) - 1)
' Check if the firstTwoOctets exist in the second worksheet
If WorksheetFunction.CountIf(ws2.UsedRange, firstTwoOctets) > 0 Then
' If it exists, add the entire IP address to the list to delete
opticsToDelete = opticsToDelete & ipPart & ","
End If
Next ipPart
Of course I'm not getting proper reults or errors and I am way beyond my ability. Thank you for any suggestions or assistance!
