VBA to Delete nth multiple rows

[Ollie7957]

Good afternoon all,

I am hoping someone can help with some code I am trying to write, although I know some VBA, certain things still elude me!

On the attached spreadsheet, I basically want to put a "Yes" or an "No" in column H, an I need a piece of code that will then go to the "Data" tab and delete all the corresponding "No" rows from the "Data" sheet, so I am left with 2 lines of data in the "Data" tab where there is a "Yes" next to the person's name.

It sounds very basic as I am typing this, however my knowledge is only beginner, so thank you in advance for your help!

[BellyGas]

The cell values shown on the control sheet are taken from the data sheet

eg: =IF(ISBLANK(Data!B6),"",Data!B6)

if you start deleting rows from the data sheet you'll end up with lots of #REFs on the control sheet.

[Ollie7957]

The cell values shown on the control sheet are taken from the data sheet

eg: =IF(ISBLANK(Data!B6),"",Data!B6)

if you start deleting rows from the data sheet you'll end up with lots of #REFs on the control sheet.

I did understand that would happen, although thank you for pointing it out. I will be writing in a part of the macro to copy the formula from somewhere else and fill down all the relevant cells, I have done this many times before and it works a treat, but that isn't the issue.

The issue I have is how to get the VBA to delete the lines in the first place.

[BellyGas]

You may need an "application.displayalerts = false" in there as well or you'll be clicking lots of 'are you sure' messages.

[BellyGas]

sub DeleteStuff

Dim Sweep as Long
Dim DataSweep as Long


for Sweep = 2 to range("Control!A1048000").end(xlup).row

     If Range("Control!H" & sweep).value = "No" then
          For DataSweep = range("Data!A1048000").end(xlup).row to 2 step -1 
                 if range("Data!A" & datasweep).value = range("Control!A" & sweep).value then                 
                         sheets("Data").rows(datasweep & ":" & datasweep).entirerow.delete
                 end if
          Next DataSweep
     End if
Next Sweep

End Sub

Not tested, just off top of head.

[BellyGas]

Edited above code. I'd completely missed the IF statement to check if the K number matches.


And for clarity:

range("Control!A1048000").end(xlup).row - will return the row number of the final row with any data in it in column A. ie, find the last row to search to.




For DataSweep = range("Data!A1048000").end(xlup).row to 2 step -1 - again, finds the last row with data in it but the loop counts backwards, ie from the last row upwards to row 2. This is cos you're deleting rows so if you were counting downwards you'd miss the next row every time you deleted one.

[Ollie7957]

Thank you very much BellyGas, I will try this out and let you know!

[Winon]

Wrong solution, will correct and post back

[Sintek]

Just for the fun of it...Taking into account the mention of you correcting the formula's referencing data sheet which will error...
Another simple solution...

Option Explicit

Sub Ollie()
Application.ScreenUpdating = False
With Sheets("Data")
    .Range("E2:E" & .Range("D" & Rows.Count).End(xlUp).Row).Formula = "=INDEX('Control'!$H$2:$H$1048576,MATCH(B2,'Control'!$C$2:$C$1048576,0))"
    With .Cells(1).CurrentRegion
        .AutoFilter 5, "No"
        .Offset(1, 0).EntireRow.Delete
    End With
    '.Columns("E:E").ClearContents
    .AutoFilterMode = False
End With
Application.ScreenUpdating = True
End Sub

[Ollie7957]

Thank you all so much, they all worked and do what I need it to!!! Thank you for the help everyone!!

[Sintek]

...........................................
Thanks.gif