title: Excel VBA Macro combing through 80,000+ rows of data taking 23 hours to complete
body: <p>I'm new here and just got into Excel VBA coding. </p>
  
  <p>I'm having an issue with a snippet of code I ran. I have multiple columns to show the status of a loan payment. </p>
  
  <ul>
  <li>Column 1 shows the numerical value of the year (i.e. Jan = 1, Feb = 2, etc.).</li>
  <li>Column 4 shows the ID number of the contract. </li>
  <li>Column 5 shows the status of the loan payment (CURRENT = currently paid, 1-23 = 1 to 23 days delinquent, 24-59 = 24 to 59 days delinquent, etc.).</li>
  <li>Column 6 shows the amount of $$$'s owed.</li>
  </ul>
  
  <p>My goal: </p>
  
  <ol>
  <li>Have the code use the ID and search for ID numbers in the list below it. </li>
  <li>Then, if there is a match in ID, it checks if the months are sequential (i.e. if the month of the ID in the current row matches the ID in the loop row and if the month is one above the current row, so if it finds a match for the ID in January, it will look for the same ID in February). </li>
  <li>Then, it will check Column 5 to see if the account transitioned into delinquency from the previous month (i.e. if the Delinquency was CURRENT in January and then went into the 1-23 days delinquent bucket in February).</li>
  <li>Finally, if all of these are true (the ID's match up, the month is sequential, and the delinquency shifted) it will drop the amount owed into a Column related to the delinquency shift (Columns 7-9).</li>
  </ol>
  
  <p>My issue: I am running this with a statusbar update to check if it's running. It's going at about 1 iteration of i per second. At 83,110 rows of data, I calculate this to take about 23 hours. HOLY SMOKES! Is there any way to expedite this?</p>
  
  <p>Here's my code:</p>
  
  <pre><code>Sub DecipherDPD()
  
  Dim i As Long, CurrentRow As Long, IDSearch As Long
  Dim RawData As Worksheet
  Dim CollectionsWB As Workbook
  
  Set CollectionsWB = ThisWorkbook
  
  Set RawData = CollectionsWB.Worksheets("RAW DATA")
  
  CurrentRow = 2
  
  With Application
      .ScreenUpdating = False
      .EnableEvents = False
  End With
  
  For i = CurrentRow To 83111 Step 1
      For IDSearch = i + 1 To 83111 Step 1
          If RawData.Cells(IDSearch, 4) = RawData.Cells(i, 4) Then
              If RawData.Cells(IDSearch, 1).Value = RawData.Cells(i, 1).Value + 1 Then
                  If RawData.Cells(i, 5) = "CURRENT" Then
                      If RawData.Cells(IDSearch, 5) = "1-23" Then
                          RawData.Cells(IDSearch, 7) = RawData.Cells(IDSearch, 6)
                      End If
                  End If
              End If
              If RawData.Cells(IDSearch, 1).Value = RawData.Cells(i, 1).Value + 1 Then
                  If RawData.Cells(i, 5) = "1-23" Then
                      If RawData.Cells(IDSearch, 5) = "24-59" Then
                          RawData.Cells(IDSearch, 8) = RawData.Cells(IDSearch, 6)
                      End If
                  End If
              End If
              If RawData.Cells(IDSearch, 1).Value = RawData.Cells(i, 1).Value + 1 Then
                  If RawData.Cells(i, 5) = "24-59" Then
                      If RawData.Cells(IDSearch, 5) = "60-90" Then
                          RawData.Cells(IDSearch, 9) = RawData.Cells(IDSearch, 6)
                      End If
                  End If
              End If
              If RawData.Cells(IDSearch, 1).Value = RawData.Cells(i, 1).Value + 1 Then
                  If RawData.Cells(i, 5) = "60-90" Then
                      If RawData.Cells(IDSearch, 5) = "90+" Then
                          RawData.Cells(IDSearch, 9) = RawData.Cells(IDSearch, 6)
                      End If
                  End If
              End If
          End If
      Next IDSearch
  Next i
  
  With Application
      .ScreenUpdating = True
      .EnableEvents = True
  End With
  
  End Sub
  </code></pre>
  
  <p>Any help would be greatly appreciated! Thank you!
  -Joe</p>