4
\$\begingroup\$

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
```
\$\endgroup\$
2
  • 2
    \$\begingroup\$ It looks like you want a relational JOIN operation - perhaps the spreadsheet isn't the right hammer for this nail? \$\endgroup\$ Jan 18 at 14:24
  • \$\begingroup\$ Just curious, seeing your working code in the question, it seems that you don't need to do a checking (IF) ? In other words, your data has a consistency that when there is a blank data then it will be always in the Nth row of column 4 to 7, nowhere else .... AND the value from this Nth row of column 1 to 3, 4 to 6 will be always the same with the value of the cells above the blank cell (Nth row -1 column 4 to 7). Please CMIIW. \$\endgroup\$
    – karma
    Feb 1 at 3:14

1 Answer 1

7
\$\begingroup\$

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.

\$\endgroup\$
1
  • 1
    \$\begingroup\$ I appreciate the response and the 3 solutions you came up with to make the macro faster. I didn't realize the redundancy in my line of code haha. I'm still a novice in VBA and these solutions will help in future code. Thanks again. \$\endgroup\$ Jan 19 at 3:05

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.