Using a Counter to Select Range, Delete, and Shift Row Up

Question

I'm trying to clean my excel sheet so that all lines match with each other when I put 3 different tables from 3 different data sets next to each other. The code I have gets the job done but it's really slow. I'm wondering if there is a much faster way for excel to delete.

Example: I would like for the macro to delete Row Hi|1|2 and leave Bye|1|2. That way when the row gets deleted and the row shifts up they all line up perfectly.

Phrase	Num1	Num2	Phrase	Num1	Num2	Phrase	Num1	Num2
Hello	1	2	Hello	1	2	Hello	1	2
Hi	1	2	Bye	1	2	Hi	1	2
Bye	1	2				Bye	1	2

Sub cleanSheet()


x = 3

Do Until Cells(x, 1) = ""

If Cells(x, 1) = Cells(x, 4) And Cells(x, 4) = Cells(x, 7) And Cells(x, 1) = Cells(x, 7) Then

x = x + 1

Else

Cells(x, 1).Delete shift:=xlUp
Cells(x, 2).Delete shift:=xlUp
Cells(x, 3).Delete shift:=xlUp
Cells(x, 7).Delete shift:=xlUp
Cells(x, 8).Delete shift:=xlUp
Cells(x, 9).Delete shift:=xlUp
Cells(x, 10).Delete shift:=xlUp
Cells(x, 11).Delete shift:=xlUp
Cells(x, 12).Delete shift:=xlUp
Cells(x, 13).Delete shift:=xlUp
Cells(x, 14).Delete shift:=xlUp
Cells(x, 15).Delete shift:=xlUp
Cells(x, 16).Delete shift:=xlUp
Cells(x, 17).Delete shift:=xlUp
Cells(x, 18).Delete shift:=xlUp
Cells(x, 19).Delete shift:=xlUp

End If
Loop


End Sub
```

Answer 1

From what I understand, this code compares three cells starting at row 3. Namely the cells on this rown in columns A, D, and G. If these cells contain the same values then this row is fine, and the loop goes to the next iteration. If not, it will delete columns A to C and G to S on that specific row and tries again.

As written, your code is indeed very slow, especially if it is used on large datasets. It can be improved in three ways:

First:

Every action you do with this code is shown on the screen when you have this workbook open and run the code. To put output on the screen costs resources, and it is entirely redundant to show anything on the screen until the code is finished. Since you can't change anything to the output at all until it is done anyway. Therefore you can put Application.ScreenUpdating = False before your code. This will turn off the output to the screen and severely reduce computing time. Just make sure to put Application.ScreenUpdating = True before the end of the sub, otherwise it will remain permanently off and you'll run into major issues with your spreadsheet.

Second:

This block

Cells(x, 1).Delete shift:=xlUp
Cells(x, 2).Delete shift:=xlUp
Cells(x, 3).Delete shift:=xlUp
Cells(x, 7).Delete shift:=xlUp
Cells(x, 8).Delete shift:=xlUp
Cells(x, 9).Delete shift:=xlUp
Cells(x, 10).Delete shift:=xlUp
Cells(x, 11).Delete shift:=xlUp
Cells(x, 12).Delete shift:=xlUp
Cells(x, 13).Delete shift:=xlUp
Cells(x, 14).Delete shift:=xlUp
Cells(x, 15).Delete shift:=xlUp
Cells(x, 16).Delete shift:=xlUp
Cells(x, 17).Delete shift:=xlUp
Cells(x, 18).Delete shift:=xlUp
Cells(x, 19).Delete shift:=xlUp

deletes cells one by one. Every single one of this action requires its own computational time. It would be better to do this entire action in one go. You can do this by using the Range and Union operators:

Union(Range("A" & x & ":C" & x), Range("G" & x & ":S" & x)).Delete shift:=xlUp

This code creates a union of row x columns A to C, G to S. Then runs the delete command on all of these cells on that row in one go, severely reducing your computing time.

And last:

If Cells(x, 1) = Cells(x, 4) And Cells(x, 4) = Cells(x, 7) And Cells(x, 1) = Cells(x, 7) Then

in this case, this whole part And Cells(x, 1) = Cells(x, 7) is redundant. If 1 = 4 and 4 = 7, then 1=7 is a given. No need to separately test for that, there is no instance where 1=4, 4=7, and 1!=7. This is just a minor thing though, just a logical pet peeve of mine.

This makes your final code this:

Sub cleanSheet2()

Application.ScreenUpdating = False

x = 3

Do Until Cells(x, 1) = ""

    If Cells(x, 1) = Cells(x, 4) And Cells(x, 4) = Cells(x, 7) Then
    
        x = x + 1
        
        Else
        
            Union(Range("A" & x & ":C" & x), Range("G" & x & ":S" & x)).Delete shift:=xlUp
            
    End If
Loop

Application.ScreenUpdating = True

End Sub

After a test on 50 rows of mock data your sub averaged 30-40 seconds. The updated version managed it in less than 2.