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

 

[MARK858]

Filters what data? on what sheet? in what column? to what sheet?

As for resources see if the list from Hiker95 in the link below helps...
Hiker95 list

 

[Domroy]

I’ll get back to you as soon as I sit down at my computer! ?

 

[Domroy]

Filters what data? on what sheet? in what column? to what sheet?

OK. The sheet that I want to filter on is called "Active Listings" - and I'm filtering column D. The column header in D is "seller-sku"

I'd like to have it filter on anything that starts with...

ABHM, select all results, and paste values only in cell A3 on "ABHM" tab.

Same thing for the following:
BAD
BENZ
CANN
CTTNTL
CECO
EC4R
GUIDE
HALL
HART

...and so on and so forth. There are existing tabs for the data. I'd love to have a macro that does this all for me, so that I can save time.

Do you need a link? Or is this data sufficient?

 

[Domroy]

Ooh...also, I have other macros in this book. When I saved it with a different name, it wouldn't work anymore. Where, in the macro, do I need to change it so that it works when I save it? I assume somewhere at the beginning of the code, some sort of "active workbook" line?

 

[MARK858]

Untested but maybe something like the below (add in the rest of your criteria)?

Sub Filterit()
    Dim MyArr, i As Long

    MyArr = Array("ABHM", "BAD", "BENZ", "CANN")
    Application.ScreenUpdating = False

    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
    Application.ScreenUpdating = True
End Sub

As for your other question post your macro/s.

 

[Domroy]

Hmm...ok. So this worked, but not for all of the tabs. I checked to make sure I didn't have any typos, and I don't. So it didn't pull ABHM, but it pulled BAD and BENZ, but not CANN. When I added the rest of the criteria, it didn't work for them. I'm sure I did something wrong. Here's what it looks like now.

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

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
Application.ScreenUpdating = True
End Sub

 

[Domroy]

And here's the code for the other one - that I want to work even if I save the document somewhere else. Don't make fun...I'm still a novice at VBA :P I totally know I should/could fix the top of this one where it repeats "Selection.Delete Shift:=xlToLeft" - but I recorded the macro rather than writing it, because I"m not good enough at composing them, and I was in a time crunch.

Sub DataTable()
'
' Macro1 Macro
'

'
Columns("H:H").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Columns("I:M").Select
Selection.Delete Shift:=xlToLeft
Columns("J:O").Select
Selection.Delete Shift:=xlToLeft
Range("B1:G1").Select
Selection.Cut Destination:=Range("L1:Q1")
Columns("B:B").Select
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Columns("E:E").Select
Selection.Delete Shift:=xlToLeft
Selection.Insert Shift:=xlToRight
Columns("C:C").Select
Selection.Insert Shift:=xlToRight
Range("C3").Select
ActiveCell.FormulaR1C1 = "sku2"
Range("F3").Select
ActiveCell.FormulaR1C1 = "qty calc"
Range("C4").Select
ActiveCell.FormulaR1C1 = "=MID(RC[-1],FIND(""-"",RC[-1])+1,LEN(RC[-1]))"
Range("K1:P1").Select
Selection.Cut Destination:=Range("B1:G1")
Range("F4").Select
ActiveCell.FormulaR1C1 = "=IFERROR(IF(RC[-1]<R1C3,0,R1C4),0)"
Range("b4").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Select
Range(Selection, Selection.End(xlUp)).Select
Selection.FillDown
Range("e4").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Select
Range(Selection, Selection.End(xlUp)).Select
Selection.FillDown
Range("A3").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Dim tbl As ListObject
Set tbl = ActiveSheet.ListObjects.Add(xlSrcRange, Selection, , xlYes)
tbl.TableStyle = "TableStyleLight15"
Sheets(ActiveSheet.Name).Select
'Range("A1").Select
End Sub

 

[MARK858]

Hmm...ok. So this worked, but not for all of the tabs. I checked to make sure I didn't have any typos, and I don't. So it didn't pull ABHM, but it pulled BAD and BENZ, but not CANN. When I added the rest of the criteria, it didn't work for them. I'm sure I did something wrong. Here's what it looks like now.

Check that your Sheet names have no leading or trailing spaces as I have just tested (with the code you amended) with the original list in post # 4 and all work for me (and no reason why some should but others don't).

 

[Domroy]

I’ll check and try it again. But I named the tabs and I’m sure there are no spaces (I actually checked that before I posted). Stay tuned! ?