more efficient excel vba

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

nfstrongAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

dlmilleCommented:
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

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
stephen81Commented:
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.
nfstrongAuthor Commented:
dlmillie - I couldn't get the named ranges to work without the selection code, but other than that it works great!  Thanks!
dlmilleCommented:
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
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.