VBA Query - move row based on commission descriptions

[folz]

Hello There

We receive one excel worksheet with roughly 5000 rows of commission data. We manually sort and then cut/paste the rows to a different worksheet based on the commissions description. There are roughly 30 different types of commission descriptions that need to be moved to one of our 8 worksheets. Is there a VBA code available to would magically move everything to its proper worksheet? The commission descriptions are all in one column and an example would be....."Feature Add" in column BM pulls the entire row to worksheet "MOB".

Help please, thanks Mike

 

[Fluff]

Hi & welcome to MrExcel.
A few questions.
1) Is all this in the same workbook?
2) Do the other 8 sheets already exist, or do they need to be created?
3) If the sheets exist do they need to be over-written, or added to?
4) Can you create a list with the Commission in col A & relevant sheet name in col B, that could then be used by the macro.

 

[folz]

Hi, thanks for replying!

1) Is all this in the same workbook? Yes
2) Do the other 8 sheets already exist, or do they need to be created? The other 8 sheets already exist
3) If the sheets exist do they need to be over-written, or added to? The other sheets have headers with some column formating..E.G. hidden columns. There is no pre-existing data other than the headers and formatting. I believe they need to be added to.
4) Can you create a list with the Commission in col A & relevant sheet name in col B, that could then be used by the macro. Yes, I can do that.

 

[Fluff]

Ok, this is based on having the commission/sheet names on a sheet called "Lists" starting in A2 with headers in A1 and you data on a sheet called Sheet1

Sub folz()
    Dim Ary As Variant
    Dim i As Long
    Dim Dic As Object
    
    Set Dic = CreateObject("scripting.dictionary")
    Ary = Sheets("Lists").Range("A1").CurrentRegion.Value2
    For i = 2 To UBound(Ary)
        If Not Dic.exists(Ary(i, 2)) Then
            Dic.Add Ary(i, 2), Ary(i, 1)
        Else
            Dic(Ary(i, 2)) = Dic(Ary(i, 2)) & "," & Ary(i, 1)
        End If
    Next i
    With Sheets("Sheet1")
        For i = 0 To Dic.Count - 1
            .Range("A1:BM").AutoFilter 7, Split(Dic.items()(i), ","), xlFilterValues
            .AutoFilter.Range.Offset(1).EntireRow.Copy Sheets(Dic.keys()(i)).Range("A2")
        Next i
        .AutoFilterMode = False
    End With
End Sub

Change sheet names in red to suit

 

[folz]

Awesome, thank you, This is my first macro. Having trouble getting it to run. Getting a compile error, expected end sub. Tried creating an activex button and editing the code. It would be greatly appreciated if you could provide some additional steps for setting up this macro. I created a separate worksheet for the lists and called the worksheet with the data Sheet1. Thank you.

 

[Fluff]

You need to remove the Sub folz() line, which should get rid of the error.
That said it looks as though your data is in a structured table, is that correct?
Also do you want the hidden columns copied?

 

[folz]

Thanks, the data has some structure. I removed the filters, but some columns are hidden. Yes, I want the hidden columns copied. Getting a runtime error 1004 after removing what you suggested.

 

[Fluff]

As you are using tables try

    Dim Ary As Variant
    Dim i As Long
    Dim Dic As Object
    
    Set Dic = CreateObject("scripting.dictionary")
    Ary = Sheets("Lists").Range("A1").CurrentRegion.Value2
    For i = 2 To UBound(Ary)
        If Not Dic.exists(Ary(i, 2)) Then
            Dic.Add Ary(i, 2), Ary(i, 1)
        Else
            Dic(Ary(i, 2)) = Dic(Ary(i, 2)) & "," & Ary(i, 1)
        End If
    Next i
    With Sheets("Sheet1").ListObjects("Table1").DataBodyRange
        .Columns.Hidden = False
        For i = 0 To Dic.Count - 1
            .AutoFilter 35, Split(Dic.items()(i), ","), xlFilterValues
            .Offset(1).Copy Sheets(Dic.keys()(i)).Range("A2")
        Next i
        .Parent.ShowAllData
    End With

You will need to change the table name in red suit

 

[folz]

Thanks so much for your help. Feels like I am so close. The script ran with out error, but the macro icon in the bottom left hand corner flashes that 0 of 3008 entries were found. I created a table and left it as Table1.

 

[Fluff]

Oops there's a typo in the field number it should be
.AutoFilter 65, Split(Dic.items()(i), ","), xlFilterValues for column BM.