1

A report produces a sheet that looks like this:

Fig1: Starting Data Format is inherited from source data, data is in cols A, D and G, with A merging ABC, D merging DEF and G on its own.

I want to keep only the lines highlighted in blue. I want the macro to check the contents of G:G and if Cell.Text = "" then entirerow.delete, else leave it alone.

Only problem is when it deletes row 2, then row 3 becomes row 2, meaning that it doesn't delete it, because it's already checked row 2. What was row 4 now becomes row 3, which is the next one to check, and it sees that text is there and doesn't delete, moves on to row four, deletes it, row 5 becomes row 4, remains unchecked, it moves on to row 6 (now row 5), sees that's blank, deletes it, but row 7 now becomes row 6 and isn't deleted... and so on.

The only way I've found around it is to use GOTO to restart the loop, then to use another GOTO to get out of the loop early. I appreciate that probably isn't the most elegant solution.

iRange = Application.Workbooks(2).Worksheets(2).Cells(Rows.Count, "A").End(xlUp).Row + 1
Debug.Print (iRange)

RestartLoop:

For Each rCell In Application.Workbooks(2).Worksheets(2).Range("G2:G" & iRange)

    If Not rCell.Offset(0, -3).Value = "" Then

        If rCell.Text = "" Then
            Debug.Print (rCell.Address)
            rCell.EntireRow.Delete
            GoTo RestartLoop
        End If

    Else0

        GoTo LeaveLoop

    End If
Next rCell

LeaveLoop:
'Do the next thing

(code is Option Explicit: Dim iRange As Integer Dim rCell as Range in declarations at top of code)

Here's the debug.print:

26 
$G$2
$G$2
$G$3
$G$3
$G$3
$G$3
$G$3
$G$3
$G$3
$G$3
$G$3
$G$4
$G$4
$G$4
$G$4
$G$4
$G$6
$G$6
$G$7

If anyone knows of a solution, and can also explain it for a layman, I'd appreciate it. The solution needs to be dynamic, because the original sheet produced is a different length each time, with a different number of blank and blue cells each time.

I have searched around a little but either I'm not understanding the answers fully, or they seem to give me the same problem.

10
  • 6
    The simple answer is to use a For r = iRange To 2 Step -1 loop. The more complicated answer is to find one of the hundred or more similar questions so that we can mark this question as a duplicate. Commented Mar 31, 2017 at 8:55
  • 1
    Stay positive @YowE3K, I'll find a good dupe :P Commented Mar 31, 2017 at 8:56
  • 2
    @CallumDA - Found one. Commented Mar 31, 2017 at 8:57
  • The filter may assist on a simple empty cell delete, filter for blanks, delete selected data, filter off. Commented Mar 31, 2017 at 8:58
  • 2
    I refuse to post it as an answer, but your code will probably become With Application.Workbooks(2).Worksheets(2) For r = .Cells(.Rows.Count, "A").End(xlUp).Row + 1 To 2 Step -1 If .Cells(r, "D").Value <> "" And .Cells(r, "G").Text = "" Then .Rows(r).Delete Next End With, but taking some hints from the link provided by @Ralph would allow you to speed things up a bit as well. Commented Mar 31, 2017 at 9:12

2 Answers 2

2

Have a look at the below, it works by building up a range from the cells which match your criteria then deleting all of them in one go. When testing this always do it on a copy of your original to make sure results are as expected before making it permanent

Dim DeleteRng As Range

Application.ScreenUpdating = False

IRange = Application.Workbooks(2).Worksheets(2).Cells(Rows.Count, "A").End(xlUp).Row + 1

Debug.Print IRange

' This is dangerous, select workbook using ThisWorkbook, or setting the workbook to a variable
' Not just using the number, this could change when opening other workbooks as well
' Similar with above when setting IRange
For Each rcell In Application.Workbooks(2).Worksheets(2).Range("G2:G" & IRange)
    If Not rcell.Offset(0, -3).value = vbNullString And rcell.Text = vbNullString Then
        If DeleteRng Is Nothing Then
            Set DeleteRng = rcell
        Else
            Set DeleteRng = Union(DeleteRng, rcell)
        End If
    End If
Next rcell
Debug.Print DeleteRng.Address
DeleteRng.EntireRow.Delete

Application.ScreenUpdating = True
Sign up to request clarification or add additional context in comments.

4 Comments

Why are you answering a question that has been clearly identified as a duplicate and has perfectly good answers elsewhere? I'm not 100% sure but I think higher powers than us delete closed questions like this that add no value since they've already been asked and answered elsewhere
Quite simple really. When I answered it, it wasn't marked as a duplicate - Look at the time stamps
@CallumDA Would you rather I deleted it?
@CallumDA - From memory, I think the duplicate questions are usually left (unless they have been marked as poor quality, etc) because they can act as search targets that will then refer people to the "original" question / answer.
1

You should use Autofilter on G column for selecting blank rows and then delete those rows, so can have all those rows where there is text in G. This will delete all rows where column G has a blank cell.New row needs to be added i.e. dummy row so as it serves as a reference point to further select and delete rows

Dim lastrow As Long
lastrow = Range("A" & Rows.Count).End(xlUp).Row
' Add dummy row
Rows("1:1").Copy
Rows("2:2").Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Rows("2:2").Paste
CutCopyMode = False

'add filter
With ActiveSheet

.AutoFilterMode = False
.Range("A2:G2").AutoFilter field:=7, Criteria1:="=", Operator:=xlOr, Criteria2:="=" & ""
End With

'delete blank rows
Range("A2:G2").Select
Range(Selection, Selection.End(xlDown)).EntireRow.Delete

Hope this helps :)

4 Comments

What is with all the Select statements? Don't use the macro recorder output for an answer. It's sloppy at best
@tom I'm new to VBA, and the only way I know to call a range for any operation is by select, will try to learn further. Thanks
Combine the Selection and Select rows e.g. Rows(1:1).Select : Selection.Copy Becomes Rows(1:1).Copy unless you need to do something visually you should very very rarely be using Select statements
Thanks for the input.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.