Optimize VBA Code

    Hello all,


    Below I've pasted some code for a macro that I've been using. The macro chugs quite slowly on my computer, and actually crashed my boss's computer.


    The macro runs through a number of operations, like filling data into blank cells, deleting entries that meet certain criteria, and splitting the remaining data into different sheets.


    I was wondering if there's any way I can optimize this code so it runs faster. When pasted into a Word document, the code is 7 pages long.


    Thank you for any help!


    Re: Optimizing My Code


    Holy Moley.
    Start with some quick fixes first:


    First
    replace this...

    Code
    Columns("A:A").EntireColumn.AutoFit 
    Columns("B:B").EntireColumn.AutoFit 
    Columns("C:C").EntireColumn.AutoFit 
    Columns("D:D").EntireColumn.AutoFit 
    Columns("E:E").EntireColumn.AutoFit 
    Columns("F:F").EntireColumn.AutoFit 
    Columns("G:G").EntireColumn.AutoFit


    with this....

    Code
    Columns("A:G").AutoFit


    ...repeat where useful.


    Next...
    Anytime you select a cell and then use selection.whatever like this...

    Code
    Columns("G:G").Select 
    Selection.NumberFormat = "0.00%"


    combine the two like this....

    Code
    Columns("G:G").NumberFormat = "0.00%"


    Then remove other unnecessary select statements like:

    Code
    Range("A1").Select


    ...when they are there for no reason.
    The only real reason you might use select is to place the selection where you'd like the user to start after the macro is finished.(Though you may use it to switch worksheets if you don't want to reference cells with their sheet name)

    "The more you know, the less you don't know."

    Re: Optimizing My Code


    As a starting point, you almost never need to use ".select". ANywhere you have "something.select" followed by "selection.something" you can combine the two as below..


    Code
    Range("A1:G10000").Select 
    Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("C2") _ 
    , Order2:=xlAscending, Key3:=Range("G2"), Order3:=xlAscending,  Header:= _ 
    xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ 
    DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:= _ 
    xlSortNormal


    would become


    Code
    Range("A1:G10000").Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("C2") _ 
    , Order2:=xlAscending, Key3:=Range("G2"), Order3:=xlAscending,  Header:= _ 
    xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ 
    DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:= _ 
    xlSortNormal


    Ger

    _______________________________________________
    There are 10 types of people in the world. Those that understand Binary and those that dont. :P


    Why are Halloween and Christmas the same? Because Oct 31 = Dec 25... ;)

    _______________________________________________

    Re: Optimizing My Code


    A lot of this code I did by recording my actions, and then copying the code out. Hence all the selections.


    Now, for instances where I have this....


    Code
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Product Code"


    Can I change it to something like this?


    Code
    Range("A1:).FormulaR1C1 = "Product Code"

    Re: Optimizing My Code


    yes you can change it to:


    Code
    Range("A1").FormulaR1C1 = "Product Code"

    "The more you know, the less you don't know."

    Re: Optimizing My Code


    Okay, cool.


    So now, if you look at the last part of the code, I'm basically performing the same operation (adding the same headers) to seven different sheets. Is there a way to streamline this, to where I put the commands in once and have the macro perform that action to the seven sheets, rather than doing each one individually?

    Re: Optimizing My Code


    yes:


    "The more you know, the less you don't know."

    Re: Optimizing My Code


    I'm not sure I understand this correctly. Would my code look like this?



    So the "Totals" sheet would get the first set of headers, and all other sheets get the second set of headers.


    If this is correct, is there also a way to incorporate inserting a new row at the top for the headers, and formatting the "Margin %" column a certain way?

    Re: Optimizing My Code


    Another thing to try would be to run the code against the used range rather than using Cells which will involve every cell in the worksheet(s).

    Boo!:yikes:

    Re: Optimizing My Code


    Norie...I have no idea what that means. Sorry, I just started with VBA like two weeks ago.


    So far we've trimmed the code from 7 pages to 4.5, and it runs a lot faster. Instead of putting the "inserting rows" and "cell formatting" code in with the loop, I had a small section of code before the loop that performed those operations, and also a small section afterward that auto-fit the columns.


    If you guys have any more ideas / explanation, I'd be glad to hear them.

    Re: Optimizing My Code


    Re-post your new shortened code and we'll see if there is anything else there can be trimmed down.


    Ger

    _______________________________________________
    There are 10 types of people in the world. Those that understand Binary and those that dont. :P


    Why are Halloween and Christmas the same? Because Oct 31 = Dec 25... ;)

    _______________________________________________

    Re: Optimizing My Code


    What I mean is that code like this which use Cells is operating on every cell in the worksheet.

    Code
    Cells.Replace What:="01 - Parts Domestic", Replacement:="01", LookAt:= _ 
    xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ 
    ReplaceFormat:=False


    That's 16777216 cells.:)

    Boo!:yikes:

    Re: Optimizing My Code


    You could avoid the loop here.


    replace


    [vba]For i = 6 To lastrow
    If Range("C" & i).Value = "" Then
    Range("C" & i - 1 & ":C" & i - 1).Copy Destination:=Range("C" & i)
    End If
    Next i[/vba]


    with


    [vba]With Range("C6:C" & lastrow)
    On Error Resume Next
    .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
    On Error GoTo 0
    .Value = .Value
    End With[/vba]


    HTH

    Re: Optimizing My Code


    Quote from norie

    What I mean is that code like this which use Cells is operating on every cell in the worksheet.

    Code
    Cells.Replace What:="01 - Parts Domestic", Replacement:="01", LookAt:= _ 
    xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ 
    ReplaceFormat:=False


    That's 16777216 cells.:)



    Okay, so how would I change that to where it only searches my range instead of the whole sheet?

    Re: Optimizing My Code


    Thanks for the suggestions, everybody. Everything is working well so far.


    I'll try and post the code a little bit later; the website kind of freezes when I try to post the whole thing.

    Re: Optimizing My Code


    Without knowing what is on this sheet...


    l

    Code
    lastrow = Cells(Rows.Count, "A").End(xlUp).Row - 2 
    Rows(lastrow & ":" & Rows.Count).Delete Shift:=xlUp


    Looks like it could be time consuming....


    can you accomplish the same thing faster with


    l

    Code
    lastrow = Cells(Rows.Count, "A").End(xlUp).Row - 2 
    Rows(lastrow & ":" & Rows.Count).clear

    Re: Optimizing My Code


    Alright, here's the trimmed code....


    When I ran through this line by line, I found that the 'deletes entries with acceptable margin %s' section is a loop and seems to be taking by far the longest time to complete. Is there another way to accomplish this?


    Re: Optimize VBA Code


    ambarrovecchio,


    I changed a little bit your code; not sure everything works fine, because I don't have any possibility to check it. I think shouldn't be any problem to correct evtl error messages



    filippo

    Re: Optimize VBA Code


    You are still using select and you still have code like this that operates on all cells.:confused:

    Code
    Cells.Replace What:="01 - Parts Domestic", Replacement:="01", LookAt:= _ 
    xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ 
    ReplaceFormat:=False


    Try replacing Cells.

    Code
    Range("A" & lastrow).Replace What:="01 - Parts Domestic", Replacement:="01", LookAt:= _ 
    xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ 
    ReplaceFormat:=False


    By the way I don't see why you even need a find and replace since all you appear to be doing is extracting the number.


    That could easily be done with either text to columns or a formula, both of which would require you inserting a new column.

    Boo!:yikes:

Participate now!

Don’t have an account yet? Register yourself now and be a part of our community!

Register Yourself Login