How to filter, copy and delete an IP range as compare to another ip range column using vba

Question

Thanks in advance.

Decided to post another question since it's a bit different from the other one I asked.

I want to setup a auto filtering Marco to compare against a list of ipaddress range (over 50 of them) , copy out the results into a new sheet, and delete all the rows that was flitered in the original sheet,leaving the other ipaddress and other rows item intact.

Using recording marco, I can only filter and copy two ipaddress range. The ipaddress examples can be 10.61.22.* or 10.1.*. Any ip address that beings with the IP will be matched, flitered, copy into a new sheet and then deleted.

Will like to check if I can create an array for this or for the Marco/vba to compare to another column and filter the IPs I needed.

Automarco code as below

Sub IP()    
'    
' IP Macro    
'    
    Columns("H:H").Select    
    Application.CutCopyMode = False   
    Selection.AutoFilter

    ActiveSheet.Range("$H$1:$H$52509").AutoFilter Field:=1, Criteria1:= _    
        "=10.61.22*", Operator:=xlOr, Criteria2:="=10.1.**"

    Cells.Select   
    Selection.Copy  
    Sheets("Sheet2").Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False

    Sheets("Sheet1").Select   
    Range("A2:L2").Select    
    Range(Selection, Selection.End(xlDown)).Select    
    Application.CutCopyMode = False    
    Selection.EntireRow.Delete    
    ActiveSheet.ShowAllData
End Sub

You might benefit from reading [How to avoid using Select in Excel VBA](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba). — Pᴇʜ, Apr 09 '19 at 06:49

score 0 · Answer 1 · answered Apr 09 '19 at 08:27

This should work. You can obviously add more array filters. The private function was a round about way of getting the last member to place. There's better ways of doing it, but it should work

Sub IP()

Dim f_List(50) As String 'or whatever is your maximum
Dim aWS As Worksheet
Set aWS = ActiveSheet

f_List(0) = "=10.1.*"
f_List(1) = "=10.61.22*"
f_List(2) = "=10.123"
f_List(3) = "=10.2*"
'etc


Dim i As Long

For i = 0 To UBound(f_List)
    If f_List(i) <> "" Then

     Intersect(aWS.UsedRange, aWS.Columns("H:H")).AutoFilter Field:=1, Criteria1:=f_List(i)

            Range("h2:h999999").SpecialCells(xlCellTypeVisible).Copy ThePlaceToPaste

            Range("h2:h999999").SpecialCells(xlCellTypeVisible).EntireRow.Delete
            aWS.Columns("H:H").AutoFilter

    End If


Next i

End Sub

Private Function ThePlaceToPaste() As Range
Const SNAME As String = "Sheet1"
Const theColumnToPaste = "A"

Dim WS As Worksheet
Set WS = Sheets(SNAME) 'you should probably call it something else

Set ThePlaceToPaste = WS.Range(theColumnToPaste & "1")
Dim z As Long


Do
'this is sort of a weird way to get last row, not sure if you're filtering or what, but it should work.
z = Application.WorksheetFunction.CountA(Range(ThePlaceToPaste, WS.Cells(Rows.Count, Range(theColumnToPaste & "1").Column)))

Set ThePlaceToPaste = ThePlaceToPaste.Offset(z, 0)

Loop Until z = 0

End Function

Oh. Thank you. It works but I actually need to copy the whole filtered results including all the rows and columns of A to L ad paste it into another sheet.I will try to edit the codes. Let's hope I can do it =) Thanks again. — Clayton Liau, Apr 11 '19 at 01:51

How to filter, copy and delete an IP range as compare to another ip range column using vba

1 Answers1