Looking to slim and speed up this code

[DanK]

This code works but is slow and cumber sum, i wondered if there is a faster way of doing this or at least cutting the code down.
With "curCell" i have to keep selecting the cell from which to start from as a place marker. The value it is looking for is in column "O" but the value it needs to continue is in column "C".

Sub Clean()
' This code will remove any archived data from the array.
Workbooks("Slot Array3.5.xls").Worksheets("Master").Activate
Sheets("Master").UnProtect Password = WorkBooks("Slot Array 3.5.xls").WorkSheets("Intro").Range("U2")
Range("C5").Select

' Looks in the Slot Array "Master" sheet for outdated listings,
' removes each listing and places a counter in column "P", once completed removes the counter
For Each curCell In Range("C5:C5004").Cells
If curCell.Offset(0, 10).Value = "4" Then
curCell.Offset(0, 1).ClearContents
curCell.Offset(0, 11).Value = "1"
End If
Range("C5").Select
If curCell.Offset(0, 11).Value = "1" Then
curCell.Offset(0, 3).ClearContents
curCell.Offset(0, 11).Value = "2"
End If
Range("C5").Select
If curCell.Offset(0, 11).Value = "2" Then
curCell.Offset(0, 5).ClearContents
curCell.Offset(0, 11).Value = "3"
End If
Range("C5").Select
If curCell.Offset(0, 11).Value = "3" Then
curCell.Offset(0, 6).ClearContents
curCell.Offset(0, 11).Value = "4"
End If
Range("C5").Select
If curCell.Offset(0, 11).Value = "4" Then
curCell.Offset(0, 7).ClearContents
curCell.Offset(0, 11).Value = "5"
End If
Range("C5").Select
If curCell.Offset(0, 11).Value = "5" Then
curCell.Offset(0, 8).ClearContents
curCell.Offset(0, 11).Value = "6"
End If
Range("C5").Select
If curCell.Offset(0, 11).Value = "6" Then
curCell.Offset(0, 9).ClearContents
curCell.Offset(0, 11).Value = "7"
End If
Range("C5").Select
If curCell.Offset(0, 11).Value = "7" Then
curCell.Offset(0, 0).ClearContents
curCell.Offset(0, 11).Value = "8"
End If
Range("C5").Select
If curCell.Offset(0, 11).Value = "8" Then
curCell.Offset(0, 10).ClearContents
curCell.Offset(0, 11).ClearContents
End If
Next curCell
End Sub

 

[Joe4]

There are a few general suggestions you can use to help speed up code, such as:

1. Put

Application.ScreenUpdating = False

at the beinning of your code and

Application.ScreenUpdating = True

at the end of your code. This will suppress screen updates while the code is running, thus speeding up the code.

2. Try to limit/eliminate as many ".Select" or ".Activate" statements as you can. These are often unnecessary. I am unsure why you have the Range("C5").Select statement in there so many times (but then I am unsure exactly what your code is supposed to be doing).

3. You may be abe to use a "SELECT CASE" statement or two instead of all the "IF" statements, but it is tough to tell because I am not sure what your code is supposed to be doing. See this link here for details on "SELECT CASE": http://www.techonthenet.com/excel/formulas/case.php

If you would like additional help in re-writing your code, it might best to post a small sample of data, and explain what the macro is supposed to do to it.

 

[DanK]

Yeah the screen updating has come to my attention as a great means of speeding things up.
The multiple times Range("C5").Select appears is because of curCell, each if statement is looking for the number "4" in column 10 but starts in column 3 (this has to do with the original xls and where data is placed). the 10th column is used as a status and used in another script, but for this one it tells if the data should be removed.
When i use the curCell and it selects the cell and removes the data then it becomes the active cell throwing all other curCell's off and returning an error, therefore i had to keep returning it back to the beginning by Range("C5").Select.
The first set of curCell is set to establish a counter in column 11 so it can continue to mark the rows that are set to be removed before returning and moving up the numbers in the counter until reaching an 8 counter then removing the counter.
This script accomplishes my goal but is far to large and cumber sum and i am sure there is a better way of doing it.
I would attach the test book but i don't see the option to do so.

 

[cb12]

From reading your code (and your description) it seems as though your code is checking column M for the value of 4 and then proceeding to delete the data for that row in columns C,D,F,G,H,I,J and K. Is that right?

I might have missed something but if not why not try:

Sub test()
Dim i As Integer
Application.ScreenUpdating = False

    For i = 5 To 5004
    
        If Cells(i, 13).Value = 4 Then
            Cells(i, 3).Resize(1, 2).ClearContents
            Cells(i, 6).ClearContents
            Cells(i, 8).Resize(1, 6).ClearContents
        End If
    
    Next i
    
Application.ScreenUpdating = True
End Sub

 

[p45cal]

Try stepping through this code with F8 and if it selects the right cells in each row to delete then change Select to ClearContents:

Sub Clean()
Workbooks("Slot Array3.5.xls").Worksheets("Master").Activate
Sheets("Master").Unprotect Password = Workbooks("Slot Array 3.5.xls").Worksheets("Intro").Range("U2")

For Each curcell In Range("C5:C5004").Cells
    If curcell.Offset(0, 10).Value = "4" Then
        curcell.EntireRow.Range("C1:D1,F1,H1:M1").Select    'ClearContents
    End If
Next curcell
End Sub

 

[DanK]

p45cal
i tried this and it worked, far easier to use thanx.