Solved

more efficient excel vba

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

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

VMware Disaster Recovery and Data Protection

In this expert guide, you’ll learn about the components of a Modern Data Center. You will use cases for the value-added capabilities of Veeam®, including combining backup and replication for VMware disaster recovery and using replication for data center migration.

Question has a verified solution.

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

INDEX and MATCH can be used to great effect to replace HLOOKUP and VLOOKUP as it does not have the limitation of needing the data to be sorted so that the reference value is in the first column or row. It also has the ability to perform a bi-directi…
This article will guide you to convert a grid from a picture into Excel format using Microsoft OneNote and no other 3rd party application.
This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.
This Micro Tutorial will demonstrate how to create pivot charts out of a data set. I also added a drop-down menu which allows to choose from different categories in the data set and the chart will automatically update.

803 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