Conditional Copying and Pasting of a Row

[Madraykin]

Hi All,

Presume this will be VBA-based - I have the below table (sensitive data, so I've dummied some data into my table structure)

Digit	Type	Population	Channel	Message 1	Message 2
1	Red	0	STOP	STOP	STOP
2	Blue	1000	Online	Hi	Goodbye
3	Green	5000	Online	Hello	See ya
4	Black	0	STOP	STOP	Stop
5	Yellow	10000	Online	Good Morning	Adios

<tbody>
</tbody>

Basically I am automating a huge string of processes into my spreadsheet that will action when I choose a value from a drop-down box in sheet 'Step 1' - so far I have achieved all of this by formulae alone, but what I need to do now is create a definitive list that only shows the rows with a population greater than 0, and which don't read 'STOP' in the cells (all of the 0 population rows will read STOP - anything with a population above 0 will contain data)

So the above is in a sheet called 'Step 3' - I need something that will look at the above table, select rows 2,3 and 5 (ie. those with populations greater than 0) and then paste them below the table in a new list (this will start at cell A91 on sheet 'Step 3')

I'm still a VBA beginner in terms of writing my own code but am getting better at understanding what code actually does, and how to adapt it

If this process could be something that triggers automatically when the source cells are populated (at the moment they are blank until I choose my variable from the dropdown on Step 1 sheet) that would be even better!

Any help appreciated - I really learn something new from you guys each time I post on here!

Thanks in advance

Mads

PS if needed my original data starts in Row 59 (Columns A-F) and finishes at Row 83 (Columns A-F)

 

[mumps]

You haven't wasted my time. I will work on a modification of the macro based on what I can see in your picture and we can go from there.

 

[Madraykin]

Thank you so much! I've got it kind of working now, but it's pasting all of the rows with zero values rather than the rows without zero values - I'm quite enjoying this sleuthing!

 

[mumps]

Try:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("I1")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Sheets("Step 3").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Sheets("Step 3").Range("A58:F" & LastRow).AutoFilter Field:=3, Criteria1:=">0"
    Sheets("Step 3").Range("A59:F" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow.Copy
    Sheets("Step 3").Range("A151").PasteSpecial xlPasteValues
    If Sheets("Step 3").AutoFilterMode = True Then Sheets("Step 3").AutoFilterMode = False
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

 

[Fluff]

As you are pasting values below the existing table, I'd suggest changing this line

LastRow = Sheets("Step 3").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

to

    LastRow = Sheets("Step 3").Range("A58").End(xlDown).Row

 

[Madraykin]

We have lift off!!!!!

That is populating correctly now, fantastic work mumps you're a star!

Now I have to try and work out how to return the sheet to its native state for when I pick a new variable from the dropdown, as currently it's giving a 'can't copy and paste over existing data' error or an empty cells error if I delete them manually.

I'm going to keep trying and see where I get to.

Wishes of being able to repay your kindness coming right at you mumps!

 

[Madraykin]

Thank you so much to both mumps and Fluff yesterday - my spreadsheet model is now complete and is doing everything I want it to!!! I'm so pleased. I've managed to write Step 4 and a macro to 'reset' the sheet, the only issue I'm having now is that the code that mumps so kindly provided yesterday (which is, I must add, working perfectly) is causing a final error message on reset of the spreadsheet - a Run Time Error 1004 - No Cells were found error.

The code that mumps and Fluff helped me with (adapted to fit my needs) goes like this:

Private Sub Worksheet_Change(ByVal Target As Range)    If Intersect(Target, Range("I1")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Sheets("Step 3").Range("A58").End(xlDown).Row
    Sheets("Step 3").Range("A58:F" & LastRow).AutoFilter Field:=3, Criteria1:=">0"
    Sheets("Step 3").Range("A59:F" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow.Copy
    Sheets("Step 3").Range("A151").PasteSpecial xlPasteValues
    If Sheets("Step 3").AutoFilterMode = True Then Sheets("Step 3").AutoFilterMode = False
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

Does anyone know how I can get rid of the error message that pops up when cell I1 on Sheet Step 1 becomes blank again?

Any help appreciated as always!

 

[Fluff]

As mumps seems to be offline at the mo.
Try this

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("I1")) Is Nothing [COLOR=#0000ff]Or Len(Target) = 0[/COLOR] Then Exit Sub
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Sheets("Step 3").Range("A58").End(xlDown).Row
    Sheets("Step 3").Range("A58:F" & LastRow).AutoFilter Field:=3, Criteria1:=">0"
    Sheets("Step 3").Range("A59:F" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow.copy
    Sheets("Step 3").Range("A151").PasteSpecial xlPasteValues
    If Sheets("Step 3").AutoFilterMode = True Then Sheets("Step 3").AutoFilterMode = False
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

 

[Madraykin]

Worked like a charm Fluff - you really are all big Stars on here aren't you?

Big Brownie points for me this end

Thank you so so much!

 

[Fluff]

Glad we could help & thanks for the feedback

 

[mumps]

Glad it all worked out.