help to optimise a code

[luvbite38]

Hi,

can someone kindly help me optimise the following slow code.... it is currently taking upto 10s..... is there a way to make it real fast and furious?

Sub ThirdRanked()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
 
 
   Dim rFind As Range
Dim lRow As Long
If Sheets("ThirdRankFinder").Range("C3") = "" Then
MsgBox ("Select the Skill Category")
Exit Sub
Else
Sheets("AllSkills").Select
Rows("1:2").Select
    Selection.Delete Shift:=xlUp
 
Sheets("DataSheet").Range("GenInfo").Copy
With Sheets("AllSkillS")
.Range("A1").PasteSpecial xlPasteAll, _
    xlPasteSpecialOperationNone, False, True
    Application.CutCopyMode = False
     .Columns("J:Xfd").ClearContents
End With
With Sheets("DataSheet")
    Set rFind = .Range("A1:A" & Rows.Count).Find(What:=Sheets("ThirdRankFinder").Range("C5"), _
    LookIn:=xlValues, Lookat:=xlWhole)
 
 
       If rFind Is Nothing Then MsgBox "Selected Entry Not Found!": Exit Sub
    lRow = rFind.Row
    .Range(.Cells(lRow, 2), .Cells(lRow, Columns.Count)).Copy
 
 
 
       Sheets("AllSkills").Cells(1, Columns.Count).End(xlToLeft).Offset(, 1).PasteSpecial xlPasteAll, _
    xlPasteSpecialOperationNone, False, True
    Application.CutCopyMode = False
End With
Call FormatSkills1
    End If
 
 
 
 
' applying the filter for rank three
Sheets("AllSkills").Select
    Range("A2:J2").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$2:$J$8").AutoFilter Field:=10, Criteria1:="3"
    Columns("A:J").Copy
 
 
    Sheets("ThirdRank").Select
 
    Columns("A:J").Select
    Range("A2").Activate
    ActiveSheet.Paste
    Range("A1:J1").Select
    Sheets("AllSkills").Select
    Range("A2:J2").Select
 
    Selection.AutoFilter
    Sheets("ThirdRank").Select
    Range("A2").Activate
 
 Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
 Application.CutCopyMode = False
End Sub

Thanks in advance....

Kind Regards,

 

[tweedle]

try eliminating some of the "Select"s
i.e.

Sheets("AllSkills").Select
Rows("1:2").Select
    Selection.Delete Shift:=xlUp

becomes

Sheets("AllSkills").Activate
Rows("1:2").Delete Shift:=xlUp

    Range("A2:J2").Select
    Selection.AutoFilter

becomes

    Range("A2:J2").AutoFilter

 

[luvbite38]

thanks a million buddy,

is there a way to make the following section of the code faster pls

' applying the filter for rank three
Sheets("AllSkills").Select
Range("A2:J2").Select
Selection.AutoFilter
ActiveSheet.Range("$A$2:$J$8").AutoFilter Field:=10, Criteria1:="3"
Columns("A:J").Copy


Sheets("ThirdRank").Select

Columns("A:J").Select
Range("A2").Activate
ActiveSheet.Paste
Range("A1:J1").Select
Sheets("AllSkills").Select
Range("A2:J2").Select

Selection.AutoFilter
Sheets("ThirdRank").Select
Range("A2").Activate

 

[xenou]

Eliminating selects should speed it up (and is good practice anyway), but I'd be surprised if this gains you ten seconds given the code you've posted. However your macro has this little line in it:

Call FormatSkills1

That means there's more code that could be an issue - but you haven't posted it here.

 

[luvbite38]

ohh, this is just applying the fills on certain cells..... I have tried running the code with the formatskills1 module and it didn't make any difference.

The part i post in my last response takes the most of the time... specially the pasting bit....

Thanks once again for helping

 

[luvbite38]

i meant without the formatskills1 ******

 

[Michael M]

I don't have access to EXcel at the moment
but try

Sheets("AllSkills").Range("$A$2:$J$8").AutoFilter Field:=10, Criteria1:="3"
    Columns("A:J").Copy
    Sheets("ThirdRank").Columns("A:J").Activate
    ActiveSheet.Paste
    Sheets("AllSkills").Range("A2:J2").AutoFilter
    Sheets("ThirdRank").Range("A2").Activate
 
 Application.ScreenUpdating = True
 Application.Calculation = xlCalculationAutomatic
 Application.EnableEvents = True
 Application.CutCopyMode = False
end Sub

 

[luvbite38]

THANKSSSSSSSSSSS A MILLION ...I am really grateful for your help

Error recieved at following line of the code.........

Sheets("ThirdRank").Columns("A:J").Activate

Any idea pls

thanks once again,

gracious

 

[Rick Rothstein]

Error recieved at following line of the code.........

Sheets("ThirdRank").Columns("A:J").Activate

That is one of the few times you cannot collapse two-line Select/Selections down to one line... you cannot select or activate cells on a worksheet unless that worksheet is the active sheet. The above line of code needs to be written in two lines...

Sheets("ThirdRank").Activate
Columns("A:J").Select

 

[luvbite38]

Thank you guys...........

God bless you all............

Gracious Gracious Gracious