Macro to filter and move data

[Domroy]

I have a large data dump I get. I need to write a macro that filters data and copies it to another tab in the workbook. I’m not good with writing my own macros. I’m good with recording and editing. But my skills with VBA are limited.

Also, any great beginner tutorials for writing VBA? Would love to see what you guys think is the best tutorial.

Thanks!

Judi

 

[Domroy]

OK - I went back and ran it again. It isn't working on all the files. I THINK I figured out why. It's not looking in column D - it's looking in column A. How do I tell it to look in column D?

Thank you!

 

[MARK858]

The code I posted already looks at column D not A.

 

[Domroy]

Yup. I realized that when I went and checked. But it still isn’t working on all sheets. I wish I knew more. I don’t know why it isn’t working right.

 

[MARK858]

If it doesn't contain confidential information upload it to www.box.com, mark it for sharing and post the link it provides in the thread and I will have a look at it when I get in tonight.

 

[Domroy]

Here's a link on One Drive. https://1drv.ms/x/s!AihNCPDTynzigUzYfumW-IAla9rp

 

[MARK858]

Try the below (Btw, the reason it has taken me so long to reply is because you put the file on your One Drive and I won't download directly to my laptop from someone's One Drive).

Sub FilterItz()
    Dim MyArr, i As Long

    MyArr = Array("ABHM", "BAD", "BENZ", "CANN", "CTTNTL", "DECO", "EC4R", "GUIDE", "HALL", "HART", "KDKFT", "LAMNT", "MRSE", "OLLX", "TL", "WTCWL", "GLBL", "ROO", "KAZI", "PK", "RBY", "WIN")
    Application.ScreenUpdating = False

    For i = LBound(MyArr) To UBound(MyArr)

        With Sheets("Active Listings")
            If ActiveSheet.AutoFilterMode Then
                .Columns("A:AC").AutoFilter
            End If

            With .Range("D1:D" & .Range("D" & Rows.Count).End(xlUp).Row)
                .AutoFilter 1, MyArr(i) & "*"

                On Error Resume Next
                .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Copy
                Sheets(MyArr(i)).Range("A3").PasteSpecial xlPasteValues
                On Error GoTo 0
            End With

            .ShowAllData
        End With

    Next
    Sheets("Active Listings").Columns("A:AC").AutoFilter
    Application.ScreenUpdating = True
End Sub

 

[Domroy]

Wonderful! Thank you so much! And sorry...I didn't know that you didn't want to do One Drive, but I TOTALLY understand...for obvious reasons. Thank you so much, this is great!

Judi

 

[MARK858]

Actually please use the code below rather than what I posted

Sub FilterIt()
    Dim MyArr, i As Long

    MyArr = Array("ABHM", "BAD", "BENZ", "CANN", "CTTNTL", "DECO", "EC4R", "GUIDE", "HALL", "HART", "KDKFT", "LAMNT", "MRSE", "OLLX", "TL", "WTCWL", "GLBL", "ROO", "KAZI", "PK", "RBY", "WIN")
    Application.ScreenUpdating = False

    If Sheets("Active Listings").AutoFilterMode Then
        Sheets("Active Listings").Columns("A:AC").AutoFilter
    End If

    For i = LBound(MyArr) To UBound(MyArr)

        With Sheets("Active Listings")
            With .Range("D1:D" & .Range("D" & Rows.Count).End(xlUp).Row)
                .AutoFilter 1, MyArr(i) & "*"

                On Error Resume Next
                .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Copy
                Sheets(MyArr(i)).Range("A3").PasteSpecial xlPasteValues
                On Error GoTo 0
            End With

            .ShowAllData
        End With

    Next
    Sheets("Active Listings").Columns("A:AC").AutoFilter
    Application.ScreenUpdating = True
End Sub

and if you know the filters are always in place before running the code then use the code below instead....

Sub FilterIt2()
    Dim MyArr, i As Long

    MyArr = Array("ABHM", "BAD", "BENZ", "CANN", "CTTNTL", "DECO", "EC4R", "GUIDE", "HALL", "HART", "KDKFT", "LAMNT", "MRSE", "OLLX", "TL", "WTCWL", "GLBL", "ROO", "KAZI", "PK", "RBY", "WIN")
    Application.ScreenUpdating = False

    For i = LBound(MyArr) To UBound(MyArr)

        With Sheets("Active Listings")
            With .Range("A1:AC" & .Range("D" & Rows.Count).End(xlUp).Row)
                .AutoFilter 4, MyArr(i) & "*"

                On Error Resume Next
                .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Copy
                Sheets(MyArr(i)).Range("A3").PasteSpecial xlPasteValues
                On Error GoTo 0
            End With

            .ShowAllData
        End With

    Next
    Application.ScreenUpdating = True
End Sub

 

[Domroy]

OK! Thank you!