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

 

[Fluff]

Does this mean that the code won't run as expected?

Yes it does. You'll only get one line of data being output.

What do you mean by "OP's" code?

Original Poster, ie the code you supplied in post#1

 

[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

I spotted the reason why it was only outputting one line , I have added the line:

indi=indi+1

See post #7

If you need to check for the string containing "site" then you can change the skipt calculation line as below:

     skipt = inarr(i, 43) = "" Or (InStr(inarr(i, 43), "Site") > 0) Or (InStr(inarr(i, 43), "RA Delegate") > 0)

 

[Fluff]

I spotted the reason why it was only outputting one line , I have added the line:

Apologies I hadn't seen your post#7 when I posted Post#9.
@bearcub
Please ignore the 1st part of my post#11. If you use the code offthelip supplied in post#7 you should be ok.

 

[bearcub]

Where would I insert this line of code?

 

[offthelip]

Use this version which includes all cells that contain "Site" or "RA delegates" rather than being equal to them as per your original filter and also includes the line to increment the index when writing out so that you get more than one line of output.

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 (InStr(inarr(i, 43), "Site") > 0) Or (InStr(inarr(i, 43), "RA Delegate") > 0)
     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]

Thank you, I'll trying this tomorrow when I get to work and let you know how it works. I'll probably end up adding more criteria so I'll add these in the same structure as you have in the skipt variable

Michael

 

[bearcub]

Hello all,

I tried both of these macros but I'm missing a criteria and I think I'm entering it incorrect into the code. There would be 3 criteria, 1 for blanks (the one I'm missing), the one for RA Delegates and the other for anything that has the word Site in it (we have Site reps, incoming Site Reps, 1st - Site Reps, etc). How would I add this 3rd criteria in the criteria line.

I was entering the blank criteria in both procedures as per below but it seems that it is being ignored and skipped over. The blank rows are still on the spreadsheet after it has been run.

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

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 (InStr(inarr(i, 43), "*Site*") > 0) Or (InStr(inarr(i, 43), "RA Delegate") > 0)
     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

Thank you for your help,'

Michael

 

[offthelip]

the first part of the skipt line should be picking up the blank lines:

skipt = inarr(i, 43) = ""

this checks if the cell is equal to a blank string.
Is it possible that your blanks cells could have spaces or non printing characters in them??
To check for spaces try adding the trim function to the skipt calculation e.g:
try this:

skipt = inarr(i, 43) = "" Or (InStr(inarr(i, 43), "*Site*") > 0) Or (InStr(inarr(i, 43), "RA Delegate") > 0) or trim(inarr(i, 43))=""

 

[bearcub]

Yes, the blanks are being removed it is the Site reps that are still not being removed from the report

Could it be that the site rep in the actual report is in CAPS (I normally don't think of VBA as being case sensitive).

 

[offthelip]

The test that the code does is case sensitive, so I suggest put it in in both, unless y ou know that it will always be capitals.