Code line to delete two table rows below last filled row

[djbroek]

This macro I have doesn't work because it will deletes two rows directly below the row I'm in that have data in them.
This causes problems because those rows below me may already have data in them.

I need to change the .EntireRow.Delete line below to instead delete the next two blank rows that are beneath the last filled row in the worksheet. I'm just getting started in using VBA and have tried multiple different codes but cannot figure it out. Please help!

[SIZE=3][COLOR=#000000][FONT=Calibri]Private Sub Worksheet_Change(ByVal Target As Range)<o:p></o:p>[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Calibri]If Target.Count > 1 Then Exit Sub<o:p></o:p>[/FONT][/COLOR][/SIZE]
<o:p>[FONT=Calibri][SIZE=3][COLOR=#000000] [/COLOR][/SIZE][/FONT]</o:p>
[SIZE=3][COLOR=#000000][FONT=Calibri]Dim RowNum As Long<o:p></o:p>[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Calibri]    RowNum = Target.Row<o:p></o:p>[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Calibri]    <o:p></o:p>[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Calibri]    If WorksheetFunction.CountA(Range("D" & RowNum & ":S" & RowNum)) > 1 Then<o:p></o:p>[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Calibri]    Range("D" & RowNum & ":S" & RowNum).ClearContents<o:p></o:p>[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Calibri]    Range("D" & RowNum).Select<o:p></o:p>[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Calibri]    MsgBox "Please only make one entry per row"<o:p></o:p>[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Calibri]    Range("D" & RowNum + 1, Range("D" & RowNum + 2)).EntireRow.Delete<o:p></o:p>[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Calibri]End If<o:p></o:p>[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Calibri]End If<o:p></o:p>[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Calibri]End Sub<o:p></o:p>[/FONT][/COLOR][/SIZE]

 

[Macropod]

As the link I posted explains, the issue with cross-posting is the need for you to provide links, not an objection to cross-posting per se.

As for a solution, have you tried the one I suggested? That way, only your user profile will be affected (and it'll be the same on any PC on the network), it will apply to all workbooks, Word documents, etc, you work on equally (thus being of benefit to you with every file you work on), it won't affect the appearance of any file you work with for anyone else (printing is only one of a number of possible issues), you won't need links to other files for printing and no code is required.

 

[djbroek]

I will read up on how to provide that link.

Yes, I do adjust the screen for more comfortable viewing already. I think I know what you're thinking but it is not what it appears. The color scheme I created on this worksheet is there for a reason besides my own viewing comfort. The data also has to be linked to another worksheet to be analyzed or calculated with data from other worksheets. There are several worksheets in this workbook that have data linked to each other.

If I could just get this one little problem solved, this workbook will be ready to go.

 

[Macropod]

There are essentially two approaches to finding the 'last' row: 1) Find the last used row for a particular column; or 2) Find the last used row for the worksheet as a whole.

It is important that you understand the difference, so that you can implement the correct approach. If the number of used rows varies by column and you choose a column that doesn't have the maximum number of data rows, using #1 in this situation will delete the two rows containing data in other columns below it. By comparison, #2 only deletes the two rows below the last data row for all columns.
#1 uses code like: LRow = .Range("A" & .Cells.SpecialCells(xlCellTypeLastCell).Row).End(xlUp).Row
where 'A' is the test column.
#2 uses code like: LRow = .Cells.SpecialCells(xlCellTypeLastCell).Row

The code below uses #2.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
Dim RowNum As Long, lRow As Long
With ActiveSheet
    lRow = .Cells.SpecialCells(xlCellTypeLastCell).Row
    RowNum = Target.Row
    If WorksheetFunction.CountA(Range("D" & RowNum & ":S" & RowNum)) > 1 Then
        Range("D" & RowNum & ":S" & RowNum).ClearContents
        MsgBox "Please only make one entry per row"
        Range("A" & lRow + 1, Range("A" & lRow + 2)).EntireRow.Delete
    End If
End With
End Sub

 

[djbroek]

That absolutely did it, Paul! The worksheet looks great and works seamlessly now. So glad to not have to fuss with it now anymore.