Solved

more efficient excel vba

Posted on 2012-04-03
4
280 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 41

Accepted Solution

by:
dlmille earned 500 total points
Comment Utility
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
Comment Utility
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
Comment Utility
dlmillie - I couldn't get the named ranges to work without the selection code, but other than that it works great!  Thanks!
0
 
LVL 41

Expert Comment

by:dlmille
Comment Utility
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

Why You Should Analyze Threat Actor TTPs

After years of analyzing threat actor behavior, it’s become clear that at any given time there are specific tactics, techniques, and procedures (TTPs) that are particularly prevalent. By analyzing and understanding these TTPs, you can dramatically enhance your security program.

Join & Write a Comment

Approximate matching with VLOOKUP and MATCH seems to me to be a greatly under-used technique, and one which is vital for getting good performance out of large lookups. Until recently I would always have advised using an exact match for simplicity an…
This article will guide you to convert a grid from a picture into Excel format using Microsoft OneNote and no other 3rd party application.
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.

728 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

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now