Copy Entire Row to another worksheet if Sum in a cell is greater than a certain number

[mikohaven]

Hi!
I am wondering if it is possible to have excel copy an entire row to another worksheet if the sum in a cell is greater than a certain number.

Here is what I am doing. I have one sheet that lists every person's name that is participating in an event that is going on. On that sheet it will list the amounts of donations each person has been able to gather for the event. My column W has the total for each person on how much they have gotten in donations. I need excel to copy (not cut) that entire row to corresponding sheets such as if a person gets $100 then it will be moved to the sheet $1 - 200. If a person gets over $800 it will be moved to the $800+ sheet. So on and so forth.

I have found other VBA equations online that allows me to do this if the cell is a certain value, but it won't work with my sum equation and it doesn't do greater than statements either. I would appreciate any help and equations as my VBA skills are not advanced enough to understand everything.

mikohaven

 

[Michael M]

How many corresponding $ value sheets do you have and what is the breakdown of these sheets ?

 

[mikohaven]

If I am understanding your question correctly... I have the main sheet which is Contacted which will host all the data to be copied to the other sheets. The other sheets are "$1 - 200" "$201 - 800" "$801 - 1600" "1600+" so basically 4 criteria one over 1, one over 200, one over 800, and one over 1600. I hope I understood your question correctly.

 

[Michael M]

try this Untested

Sub MM1()
Dim lr As Long, lr2 As Long, r As Long, ws As Worksheet
lr = Sheets("Contacted").Cells(Rows.Count, "W").End(xlUp).Row
    Sheets("Contacted").Activate
    For r = lr To 2 Step -1
        Select Case Range("W" & r).Value
            Case Is < 201
                lr2 = Sheets("$1 - 200").Cells(Rows.Count, "A").End(xlUp).Row
                Rows(r).Copy Destination:=Sheets("$1 - 200").Range("A" & lr2 + 1)
             Case Is < 801
                lr2 = Sheets("$201 - 800").Cells(Rows.Count, "A").End(xlUp).Row
                Rows(r).Copy Destination:=Sheets("$201 - 800").Range("A" & lr2 + 1)
            Case Is < 1601
                lr2 = Sheets("$801 - 1600").Cells(Rows.Count, "A").End(xlUp).Row
                Rows(r).Copy Destination:=Sheets("$801 - 1600").Range("A" & lr2 + 1)
            Case Is > 1600
                lr2 = Sheets("1600+").Cells(Rows.Count, "A").End(xlUp).Row
                Rows(r).Copy Destination:=Sheets("1600+").Range("A" & lr2 + 1)
       End Select
Next r
End Sub

 

[mikohaven]

Thanks for the code.
But I cannot get it to work. I put it in the same place that I put the one that worked but wouldn't take into consideration the sum formula it had to be a number. Or I could be putting it in the wrong place. I right click on Contacted Sheet and click view code and paste it there. Am I wrong?

 

[Michael M]

Yes, it needs to go into "This Workbook" module
Press ALT + F11>>double click on "this Workbook" in LH window>>Paste code into RH window where cursor is flashing

 

[mikohaven]

Okay... I did paste it there and it still isn't doing anything, it's not giving me an error or anything.
I have put data in the Contacted sheet and I have several rows that show over $800 but it's still not copying it to the $801 - 1600 sheet. Or any amount is not moving to any other sheet.

 

[Michael M]

Are the results definitely in col "W" ?
Are the values in "W" in dollar format or text ?
I've tested about 100 lines of varying value, and it works fine
How are you firing the macro ? by ALT + F8 and select the macro ?

 

[mikohaven]

Well... I was doing ALT + F8 to get the macro to run but it still didn't do anything. So I figured it had to be my computer. So I restarted it and when I reopened back up the file it had ran the macro all those times and was now showing up. Gotta love computers.

Thanks so much for all your help!

 

[Michael M]

yep,they have a mind of their own...