Solved

more efficient excel vba

Posted on 2012-04-03
4
282 Views
Last Modified: 2012-04-03
I have the below code in a macro.  It does what I want it to do, however, it takes a very long time as there are 18000+ rows of data to go through.  Can someone help me to make this more efficient and faster?  Any help is appreciated.  Thanks!

Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Name = "OrigDateLoc"
    
    splastrow = ActiveSheet.Cells(ActiveSheet.Cells.Rows.Count, "A").End(xlUp).Row + 1
    
    'populate Amount Financed column
    Sheets("data").Activate
    Range("D2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Name = "AmtFin"
    
    For y = 2 To splastrow - 1
    For x = 1 To lLastrow
      OrigDate = Range("AmtFin").Cells(x, 1)
      Debug.Print OrigDate
      Debug.Print Format(Range("AmtFin").Cells(x, 1), "mmm-yy")
      Debug.Print Format(Range("OrigDateLoc").Cells(y, 1), "mmm-yy")
      If (Format(Range("AmtFin").Cells(x, 1).value, "mmm-yy") = Format(Range("OrigDateLoc").Cells(y, 1).value, "mmm-yy")) Then
        vlret = Range("AmtFin").Cells(x, 2).value
        Debug.Print vlret
        'If Range("OrigDateLoc").Cells(y, 1).value <> "" Then
            currval = Range("OrigDateLoc").Cells(y, 2).value
            Debug.Print currval
        'End If
      endval = currval + vlret
      Debug.Print endval
      Range("OrigDateLoc").Cells(y, 2).value = endval
      End If
    Next x
    Next y
    
    'populate Writeoff column
    For y = 2 To splastrow - 1
    For x = 1 To lLastrow
      OrigDate = Range("AmtFin").Cells(x, 1)
      Debug.Print OrigDate
      Debug.Print Format(Range("AmtFin").Cells(x, 1), "mmm-yy")
      Debug.Print Format(Range("OrigDateLoc").Cells(y, 1), "mmm-yy")
      If (Format(Range("AmtFin").Cells(x, 1).value, "mmm-yy") = Format(Range("OrigDateLoc").Cells(y, 1).value, "mmm-yy")) Then
        vlret = Range("AmtFin").Cells(x, 11).value
        Debug.Print vlret
        'If Range("OrigDateLoc").Cells(y, 1).value <> "" Then
            currval = Range("OrigDateLoc").Cells(y, 3).value
            Debug.Print currval
        'End If
      endval = currval + vlret
      Debug.Print endval
      Range("OrigDateLoc").Cells(y, 3).value = endval
      End If
    Next x
    Next y
      
    'populate percent column
    For y = 2 To splastrow - 1
        Range("OrigDateLoc").Cells(y, 4).value = Format(Range("OrigDateLoc").Cells(y, 3).value / Range("OrigDateLoc").Cells(y, 2).value, "0.00%")
    Next y
    

Open in new window

0
Comment
Question by:nfstrong
  • 2
4 Comments
 
LVL 42

Accepted Solution

by:
dlmille earned 500 total points
ID: 37802275
I took out all the debug.print statements (sorry, I guess I could have commented them but it was getting longer than needed to see the whole logic in one sheet).  I did some minor things to eliminate cell selections.  The change I made with the if, comparing month and year might be faster than formatting then comparing.

The big change is that you're doingi the loop y/x twice, when you should be able to set the first and writeoff column within the same loop.  You loop a third time through y 2-splashrow, which can also be done in the same loop.

I think I hit all the points correctly and your code should finish much more quickly.  The key change is with the loop, so you can pretty much ignore the rest if you want, though I would code as I've done to address all the selections which should not be necessary at the top of the code.

Sub doWork()
    
    Range("A1", Range("A1").End(xlDown)).End(xlToRight).Name = "OrigDateLoc"
    
    splastrow = ActiveSheet.Cells(ActiveSheet.Cells.Rows.Count, "A").End(xlUp).Row + 1

    'populate Amount Financed column
    Sheets("data").Activate
    Range("D2", Range("D2").End(xlDown)).End(xlToRight).Name = "AmtFin"


    For y = 2 To splastrow - 1
        For x = 1 To lLastrow
            OrigDate = Range("AmtFin").Cells(x, 1)
            If Month(Range("AmtFin").Cells(x, 1).Value) = Month(Range("OrigDateLoc").Cells(y, 1).Value) And _
                Year(Range("AmtFin").Cells(x, 1).Value) = Year(Range("OrigDateLoc").Cells(y, 1).Value) Then
                vlret = Range("AmtFin").Cells(x, 2).Value
                currval = Range("OrigDateLoc").Cells(y, 2).Value
                Range("OrigDateLoc").Cells(y, 2).Value = currval + vlret

                vlret = Range("AmtFin").Cells(x, 11).Value
                currval = Range("OrigDateLoc").Cells(y, 3).Value
                Range("OrigDateLoc").Cells(y, 3).Value = currval + vlret
            End If
        Next x
        Range("OrigDateLoc").Cells(y, 4).Value = Format(Range("OrigDateLoc").Cells(y, 3).Value / Range("OrigDateLoc").Cells(y, 2).Value, "0.00%")
    Next y

End Sub

Open in new window

0
 
LVL 1

Expert Comment

by:stephen81
ID: 37802315
Try to avoid selecting cells/ranges.

Wherever possible work directly on the range.

i.e.
Instead of...
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Name = "OrigDateLoc"

Open in new window


Use something like...
Range("A1").Activate
ActiveSheet.UsedRange.Name = "OrigDateLoc"

Open in new window


Every select adds overhead.
0
 

Author Comment

by:nfstrong
ID: 37803534
dlmillie - I couldn't get the named ranges to work without the selection code, but other than that it works great!  Thanks!
0
 
LVL 42

Expert Comment

by:dlmille
ID: 37803582
Sorry, I was doing mental backflips and fell on my face on that one.  Try either one of these - the latter is one line, but a bit harder to read:

Sub test()
Dim rCol As Range

    Set rCol = Range("D2", Range("D2").End(xlDown))
    Range(rCol, rCol.End(xlToRight)).Name = "AmtFin"
    
    'alternatively, but hard to read:
    Range(Range("D2", Range("D2").End(xlDown)), Range("D2", Range("D2").End(xlDown).End(xlToRight))).Name = "AmtFin"
    
End Sub

Open in new window


This should do the same as you were doing, but avoids touching the sheet.  I am not a believer in sheet touching/activating unless (few cases) absolutely necessary.  Also, I'm not a believer in UsedRange as it can give misleading results with regards to the lastRow and also includes formatted cells, as opposed to cells that have data in them (e.g., if the last row with data is 15 and a row as a format in it on row 20, then the UsedRange would lead you to believe row 20 should be included).

Dave
0

Featured Post

Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Improved? Move/Copy Add-in Replacement - How to avoid the annoying, “A formula or sheet you want to move or copy contains the name XXX, which already exists on the destination worksheet.” David Miller (dlmille)  It was one of those days… I wa…
Excel can be a tricky bit of software to get your head around. Whilst you’ll be able to eventually get to grips with the basic understanding of how to get by, there are a few Excel tips that not everybody will even know about let alone know how to d…
The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns over…
The viewer will learn how to create a normally distributed random variable in Excel, use a normal distribution to simulate the return on an investment over a period of years, Create a Monte Carlo simulation using a normal random variable, and calcul…

820 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question