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

 

[folz]

I love you! It is glorious. Great way to end the day. Thank you so much!

 

[Fluff]

My pleasure & thanks for the feedback

 

[folz]

Have one more ask. Need to easily identify if any of the rows did not move via the macro. Maybe we can we cut instead of copy, or find some other way to see rows that were not captured by the macro? Thank you

 

[Fluff]

How about highlighting rows that were copied like

        For i = 0 To Dic.Count - 1
            .AutoFilter 65, Split(Dic.items()(i), ","), xlFilterValues
            .Offset(1).Copy Sheets(Dic.keys()(i)).Range("A2")
            .Offset(1).Interior.Color = 45678
        Next i

 

[folz]

Wonderful, that will totally work. The first row is not being copied for some reason, even though the row below it has the same criteria.

 

[Fluff]

In a blank cell put
=BM2=BM3
What does it return?

 

[folz]

Result is True

 

[Fluff]

Oops, it should be

    With Sheets("Sheet1").ListObjects("Table1").DataBodyRange
        .Columns.Hidden = False
        For i = 0 To Dic.Count - 1
            .AutoFilter 65, Split(Dic.items()(i), ","), xlFilterValues
            .Copy Sheets(Dic.keys()(i)).Range("A2")
            .Interior.Color = 45678
        Next i
        .Parent.ShowAllData
    End With

 

[folz]

Man you are good! Thank you so much.

 

[Fluff]

Glad to help & thanks for the feedback