Making a macro more efficient

[bearcub]

I recorded this macro the other day but it takes about 30 seconds to run. I tried to clean it up the best i could but I'm wondering if using a loop might be more efficient.

Sub ClearBlanksSiteRepsRADelegates()
'
' ClearBlanksSiteRepsRADelegates Macro
' Clear sheet of non leadership positions before copying to appropirate SCC
'
'
    ActiveSheet.Range("$A$1:$BX$69000").AutoFilter FIELD:=43, Criteria1:="="
    ActiveCell.Offset(1, 0).Rows("1:69000").EntireRow.Select
    ActiveCell.Offset(1, 15).Range("A1").Activate
    Selection.Delete Shift:=xlUp
    ActiveSheet.Range("$A$1:$BX$4680").AutoFilter FIELD:=43, Criteria1:= _
        "=*Site*", Operator:=xlOr, Criteria2:="=*RA Delegate*"
    Selection.Delete Shift:=xlUp
    ActiveSheet.Range("$A$1:$BX$3500").AutoFilter FIELD:=43
    ActiveSheet.AutoFilterMode = "False"
End Sub
[code]/

The macro is to remove some positions in column 43 (AQ). 

Is there a more efficient way to do this so it won't take as much time to run?

Thank you for your help.,

Michael

 

[footoo]

The macro is to remove some positions in column 43 (AQ).

If all you want to do is delete (& Shift:=xlUP) cells in column AQ which contain "*Site*" or "*RA Delegate*", then try :

Sub ClearBlanksSiteRepsRADelegates()
If Not [AQ:AQ].Parent.AutoFilterMode Then [AQ:AQ].AutoFilter
ActiveSheet.[AQ:AQ].AutoFilter Field:=1, Criteria1:= _
    "=*Site*", Operator:=xlOr, Criteria2:="=*RA Delegate*"
On Error Resume Next
Range([AQ2], Cells(Rows.Count, "AQ").End(xlUp)) _
    .SpecialCells(xlCellTypeVisible).Delete Shift:=xlUp
On Error GoTo 0
ActiveSheet.AutoFilterMode = False
End Sub

 

[footoo]

Improved version :

Sub ClearBlanksSiteRepsRADelegates()
Dim lr#
If Not [AQ:AQ].Parent.AutoFilterMode Then [AQ:AQ].AutoFilter
ActiveSheet.[AQ:AQ].AutoFilter Field:=1, Criteria1:= _
    "=*Site*", Operator:=xlOr, Criteria2:="=*RA Delegate*"
lr = Cells(Rows.Count, "AQ").End(xlUp).Row
If lr > 1 Then Range([AQ2], Cells(lr, "AQ")) _
    .SpecialCells(xlCellTypeVisible).Delete Shift:=xlUp
ActiveSheet.AutoFilterMode = 0
End Sub

 

[bearcub]

Thank you, I will try this out Monday when I get back to work and let you know what happens. I'm curious to see what the time differential would be because I'm deleting close to 65,000 rows of data.

I think your code, thought is missing removing the blanks (members who don't have anything assigned to them). Plus, I might be adding some more criteria to the macro (we might be waiting to remove more positions than these two - Bargain Team Members or Member Engagement Team members as well. The list could potential include 10 or 12 different positions besides the blanks, Site Reps and RA Delegates.


Michael

 

[offthelip]

One of the main reasons that Vba is slow is the time taken to access the worksheet from VBa is a relatively long time.
To speed up vba the easiest way is to minimise the number of accesses to the worksheet. What is interesting is that the time taken to access a single cell on the worksheet in vba is almost identical as the time taken to access a large range if it is done in one action.
So instead of writing a loop which loops down a range deleting one row at a time which will take along time if you have got 65000 rows it is much quicker to load the 65000 lines into a variant array ( one worksheet access), then copy the lines which you want to retain to a variant array and then write the array back to the worksheet, ( one worksheet access for each search that you are doing),
I have a simple rule for fast VBA: NEVER ACCESS THE WORKSHEET IN A LOOP.
Equally when you delete a row using filtered cells excel is very slow at moving all the other rows up because it effectively is doing a loop round the remaining rows
This code will do this much more efficiciently, however it does change formula into values, so it won't work if you have got equations you want to retain. There are ways round this if you need to retain equations. ( this is done by saving the formula in the appropriate columns to a variant array (possibly deleting rows as per the inarr array) and then writing those columns back
This should be really fast and take less than a second to do the whole lot, (it only accesses the worksheet 4 times)

Sub test()
inarr = Range("$A$1:$BX$69000")
Range("$A$1:$BX$69000") = ""
outarr = Range("$A$1:$BX$69000")
 indi = 1
 For i = 1 To 69000
     skipt = inarr(i, 43) = "" Or inarr(i, 43) = "Site" Or inarr(i, 43) = "RA Delegate"
     If Not (skipt) Then
       ' copy line
       For k = 1 To 76
         outarr(indi, k) = inarr(i, k)
        Next k
     End If
  next i    
Range("$A$1:$BX$69000") = outarr




End Sub

 

[bearcub]

Thank you for the tips.

I don't have any formulas on the sheet so that shouldn't be an issue. I'l test this out as well. And then, if I wanted to add any criteria then I would add this to the array - skipt. So new criteria I add the worksheet will be accessed?

What does the K loop to - 1 to 76?

 

[offthelip]

Yes to add criteria you add to the skipt line, using exactly the same format.
Both varaint arrays ( inarr and outarr) my abbreviation for input array and output array are two dimensional arrays which are 69000 (rows 1 to 69000) by 76 (columns A to BX) , you can't address variant arrays by letters so is has to be numbers ( this is why I always use number addressing in vBA)
So the loop 1 to 76 is to copy one row of data from the input array to the output array.
I realised on looking at it again that I forgot to increment the index so this is the correct version:

Sub test()
inarr = Range("$A$1:$BX$69000")
Range("$A$1:$BX$69000") = ""
outarr = Range("$A$1:$BX$69000")
 indi = 1
 For i = 1 To 69000
     skipt = inarr(i, 43) = "" Or inarr(i, 43) = "Site" Or inarr(i, 43) = "RA Delegate"
     If Not (skipt) Then
       ' copy line
       For k = 1 To 76
         outarr(indi, k) = inarr(i, k)
        Next k
        indi = indi + 1
     End If
 Next i
Range("$A$1:$BX$69000") = outarr




End Sub

 

[bearcub]

Good to know, thank you for the tips and the help. I'll run this on Monday when I get back to work and let you know what happens.

I was documenting what I was doing yesterday in the file yesterday. I'm creating it for our admins to run and making this run quickly would help them not think they made a mistake.

Thank you again for the help.

Michael

 

[Fluff]

@offthelip
I think you may want to check your code, I get 1 line being output.
Also, the OP's code shows the field contains rather than equals the value

 

[bearcub]

Does this mean that the code won't run as expected? What do you mean by "OP's" code?