title: My VBA code takes far too long, any suggestions on how to shorten the time? For Loop
body: <p>My code is designed to open a file, copy the contents of the file, paste it into a working file with formulas. The formulas identify whether a row should be ignored. The code then goes through each row and copies over the row with "ignore" into a different tab and then deletes the row. The code then looks to see if "INV NOT FOUND", if the row has this designation it will then copy the row in to a new workbook and once it has gone through all of the rows, it closes and saves the new workbook.
  I have some files that are 5k+ rows and this takes far too long.</p>
  
  <p>I am not really sure how else to code the loop.</p>
  
  <pre><code>Option Explicit
  
  Sub RawData()
  Dim CurrentDate As String
  Dim PB As String
  Dim ReturnsCheck As String
  Dim Filename As String
  Dim MyRange As String
  Dim aWB As Workbook
  Dim tWB As Workbook, newSheet As Worksheet
  Dim MissingInvCount As Long
  Dim rng As Range
  Dim cell As Range
  Dim search As String
  
  Set tWB = ThisWorkbook
  
  CurrentDate = Range("C6")
  PB = Range("C8")
  
  Application.EnableCancelKey = xlDisabled
  
  Worksheets("data table").Visible = True
  
  If tWB.Worksheets("home").Range("PB") = "Citi" Then
      Worksheets("sort area").Visible = True
  ElseIf tWB.Worksheets("home").Range("PB") = "Pershing" Then
      Worksheets("pershing").Visible = True
  ElseIf tWB.Worksheets("home").Range("PB") = "JPM" Then
      Worksheets("jpm").Visible = True
  ElseIf tWB.Worksheets("home").Range("PB") = "Goldman Sachs" Then
      Worksheets("gs").Visible = True
  ElseIf tWB.Worksheets("home").Range("PB") = "Morgan Stanley" Then
      Worksheets("ms").Visible = True
  
  End If
  
  'Opens Raw file
      Workbooks.Open Filename:="G:\CMG\DCM\Operations\Monthly Cycle\Monthly Transaction Upload\" &amp; Range("PB") &amp; "\" &amp; Format(Range("CurrentDate"), "yyyy") &amp; "\Raw Files\" &amp; "Raw File - " &amp; Range("PB") &amp; " " &amp; Format(Range("CurrentDate"), "mmddyy") &amp; ".csv"
  
  
  ActiveWorkbook.Activate
  Set aWB = ActiveWorkbook
  
  If tWB.Worksheets("home").Range("PB") = "Citi" Then
      aWB.Activate
         Range("A1", Range("CZ" &amp; Rows.Count).End(xlUp)).Copy
      tWB.Worksheets("sort area").Range("A1").PasteSpecial Paste:=xlPasteValues
      Application.CutCopyMode = False
  ElseIf tWB.Worksheets("home").Range("PB") = "Pershing" Then
      aWB.Activate
         Range("A1", Range("U" &amp; Rows.Count).End(xlUp)).Copy
      tWB.Worksheets("pershing").Range("A1").PasteSpecial Paste:=xlPasteValues
      Application.CutCopyMode = False
  ElseIf tWB.Worksheets("home").Range("PB") = "JPM" Then
      aWB.Activate
         Range("A1", Range("AD" &amp; Rows.Count).End(xlUp)).Copy
      tWB.Worksheets("jpm").Range("A1").PasteSpecial Paste:=xlPasteValues
      Application.CutCopyMode = False
  ElseIf tWB.Worksheets("home").Range("PB") = "Goldman Sachs" Then
      aWB.Activate
         Range("A1", Range("V" &amp; Rows.Count).End(xlUp)).Copy
      tWB.Worksheets("gs").Range("A1").PasteSpecial Paste:=xlPasteValues
      Application.CutCopyMode = False
  ElseIf tWB.Worksheets("home").Range("PB") = "Morgan Stanley" Then
      aWB.Activate
         Range("A1", Range("L" &amp; Rows.Count).End(xlUp)).Copy
      tWB.Worksheets("ms").Range("A1").PasteSpecial Paste:=xlPasteValues
      Application.CutCopyMode = False
  End If
  
  'Closes Raw File w/o saving
      aWB.Close SaveChanges:=False
  
  'Copy Formulas down
  Dim Lastrow As Long
  
  If tWB.Worksheets("home").Range("PB") = "Citi" Then
      Worksheets("sort area").Activate
      Lastrow = Range("A" &amp; Rows.Count).End(xlUp).Row
      Range("DB2:FN" &amp; Lastrow).FillDown
  ElseIf Range("PB") = "Pershing" Then
      Worksheets("pershing").Activate
      Lastrow = Range("B" &amp; Rows.Count).End(xlUp).Row
      Range("W2:BO" &amp; Lastrow).FillDown
  ElseIf Range("PB") = "JPM" Then
      Worksheets("jpm").Activate
      Lastrow = Range("A" &amp; Rows.Count).End(xlUp).Row
      Range("AI2:CU" &amp; Lastrow).FillDown
  ElseIf Range("PB") = "Goldman Sachs" Then
      Worksheets("gs").Activate
      Lastrow = Range("A" &amp; Rows.Count).End(xlUp).Row
      Range("X2:CJ" &amp; Lastrow).FillDown
  ElseIf Range("PB") = "Morgan Stanley" Then
      Worksheets("ms").Activate
      Lastrow = Range("A" &amp; Rows.Count).End(xlUp).Row
      Range("N2:BZ" &amp; Lastrow).FillDown
  
  End If
  
  'Remove ignored lines &amp; Idenitifies missing investments
  
  Dim n As Integer
  Dim nLastRow As Long
  Dim nFirstRow As Long
  Dim r As Range
  
  
      Set r = ActiveSheet.UsedRange
      nLastRow = Lastrow - 1
      nFirstRow = 2
  
  
  Dim i As Long: i = 1
  
  With ActiveSheet
      On Error Resume Next
      Application.ScreenUpdating = False
  
      If tWB.Worksheets("home").Range("PB") = "Citi" Then
  
          For n = nLastRow To nFirstRow Step -1
              If .Cells(n, "DB") = "IGNORE" Then
                  .Cells(n, "DB").EntireRow.Copy
                   Worksheets("ignore").Cells(i, "A").PasteSpecial Paste:=xlPasteValues
                   Application.CutCopyMode = False
                  .Cells(n, "DB").EntireRow.Delete
                  i = i + 1
              End If
          Next
  
      ElseIf Range("PB") = "Pershing" Then
  
          For n = nLastRow To nFirstRow Step -1
              If .Cells(n, "W") = "IGNORE" Then
                  .Cells(n, "W").EntireRow.Copy
                   Worksheets("ignore").Cells(i, "A").PasteSpecial Paste:=xlPasteValues
                   Application.CutCopyMode = False
                  .Cells(n, "W").EntireRow.Delete
                  i = i + 1
              End If
          Next
  
      ElseIf Range("PB") = "JPM" Then
  
          For n = nLastRow To nFirstRow Step -1
              If .Cells(n, "AI") = "IGNORE" Then
                  .Cells(n, "AI").EntireRow.Copy
                   Worksheets("ignore").Cells(i, "A").PasteSpecial Paste:=xlPasteValues
                   Application.CutCopyMode = False
                  .Cells(n, "AI").EntireRow.Delete
                  i = i + 1
              End If
          Next
  
      ElseIf Range("PB") = "Goldman Sachs" Then
  
          For n = nLastRow To nFirstRow Step -1
              If .Cells(n, "X") = "IGNORE" Then
                  .Cells(n, "X").EntireRow.Copy
                   Worksheets("ignore").Cells(i, "A").PasteSpecial Paste:=xlPasteValues
                   Application.CutCopyMode = False
                  .Cells(n, "X").EntireRow.Delete
                  i = i + 1
              End If
          Next
  
      ElseIf Range("PB") = "Morgan Stanley" Then
  
          For n = nLastRow To nFirstRow Step -1
              If .Cells(n, "N") = "IGNORE" Then
                  .Cells(n, "N").EntireRow.Copy
                   Worksheets("ignore").Cells(i, "A").PasteSpecial Paste:=xlPasteValues
                   Application.CutCopyMode = False
                  .Cells(n, "N").EntireRow.Delete
                  i = i + 1
              End If
          Next
  
      End If
  End With
  
  'Sort Ignore tab
  Worksheets("ignore").Activate
  Lastrow = Cells(Rows.Count, 2).End(xlUp).Row
  
  If tWB.Worksheets("home").Range("PB") = "Citi" Then
      Range("A1:FG" &amp; Lastrow).SORT key1:=Range("DE1:DE" &amp; Lastrow), _
       order1:=xlAscending, Header:=xlNo
  
  ElseIf Range("PB") = "Pershing" Then
      Range("A1:BO" &amp; Lastrow).SORT key1:=Range("Z1:Z" &amp; Lastrow), _
       order1:=xlAscending, Header:=xlNo
  
  ElseIf Range("PB") = "JPM" Then
      Range("A1:CU" &amp; Lastrow).SORT key1:=Range("AL1:AL" &amp; Lastrow), _
       order1:=xlAscending, Header:=xlNo
  
  ElseIf Range("PB") = "Goldman Sachs" Then
      Range("A1:CJ" &amp; Lastrow).SORT key1:=Range("AA1:AA" &amp; Lastrow), _
       order1:=xlAscending, Header:=xlNo
  
  ElseIf Range("PB") = "Morgan Stanley" Then
      Range("A1:BZ" &amp; Lastrow).SORT key1:=Range("Q1:Q" &amp; Lastrow), _
       order1:=xlAscending, Header:=xlNo
  
  End If
  
  'Missing investments
  
  If tWB.Worksheets("home").Range("PB") = "Citi" Then
  
  Worksheets("sort area").Activate
  Set rng = ActiveSheet.Range("DF1:DF" &amp; Lastrow)
  search = "INV NOT FOUND"
  Set cell = rng.Find(What:=search, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
  
      If cell Is Nothing Then
          MsgBox ("There are no missing investments.")
      Else
          Set newSheet = ThisWorkbook.Sheets.Add
          Worksheets("sort area").Activate
          i = 1
  
          With ActiveSheet
          On Error Resume Next
          Application.ScreenUpdating = False
              For n = nLastRow To nFirstRow Step -1
                  If .Cells(n, "DF") = "INV NOT FOUND" Then
                      .Cells(n, "DF").EntireRow.Copy
                       newSheet.Cells(i, "A").PasteSpecial Paste:=xlPasteValues
                       Application.CutCopyMode = False
                       .Cells(n, "DF").EntireRow.Delete
                      i = i + 1
                  End If
              Next
          End With
          MissingInvCount = i - 1
      End If
  End If
  
  If Range("PB") = "Pershing" Then
  
  Worksheets("pershing").Activate
  Set rng = ActiveSheet.Range("AA1:AA" &amp; Lastrow)
  search = "INV NOT FOUND"
  Set cell = rng.Find(What:=search, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
  
      If cell Is Nothing Then
          MsgBox ("There are no missing investments.")
      Else
          Set newSheet = ThisWorkbook.Sheets.Add
          Worksheets("pershing").Activate
          i = 1
  
          With ActiveSheet
          On Error Resume Next
          Application.ScreenUpdating = False
              For n = nLastRow To nFirstRow Step -1
                  If .Cells(n, "AA") = "INV NOT FOUND" Then
                      .Cells(n, "AA").EntireRow.Copy
                       newSheet.Cells(i, "A").PasteSpecial Paste:=xlPasteValues
                       Application.CutCopyMode = False
                       .Cells(n, "AA").EntireRow.Delete
                      i = i + 1
                  End If
              Next
          End With
          MissingInvCount = i - 1
      End If
  End If
  
  If Range("PB") = "JPM" Then
  
  Worksheets("jpm").Activate
  Set rng = ActiveSheet.Range("AM1:AM" &amp; Lastrow)
  search = "INV NOT FOUND"
  Set cell = rng.Find(What:=search, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
  
      If cell Is Nothing Then
          MsgBox ("There are no missing investments.")
      Else
          Set newSheet = ThisWorkbook.Sheets.Add
          Worksheets("jpm").Activate
          i = 1
  
          With ActiveSheet
          On Error Resume Next
          Application.ScreenUpdating = False
              For n = nLastRow To nFirstRow Step -1
                  If .Cells(n, "AM") = "INV NOT FOUND" Then
                      .Cells(n, "AM").EntireRow.Copy
                       newSheet.Cells(i, "A").PasteSpecial Paste:=xlPasteValues
                       Application.CutCopyMode = False
                       .Cells(n, "AM").EntireRow.Delete
                      i = i + 1
                  End If
              Next
          End With
          MissingInvCount = i - 1
      End If
  End If
  
  If Range("PB") = "Goldman Sachs" Then
  
  Worksheets("gs").Activate
  Set rng = ActiveSheet.Range("AB1:AB" &amp; Lastrow)
  search = "INV NOT FOUND"
  Set cell = rng.Find(What:=search, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
  
      If cell Is Nothing Then
          MsgBox ("There are no missing investments.")
      Else
          Set newSheet = ThisWorkbook.Sheets.Add
          Worksheets("gs").Activate
          i = 1
  
          With ActiveSheet
          On Error Resume Next
          Application.ScreenUpdating = False
              For n = nLastRow To nFirstRow Step -1
                  If .Cells(n, "AB") = "INV NOT FOUND" Then
                      .Cells(n, "AB").EntireRow.Copy
                       newSheet.Cells(i, "A").PasteSpecial Paste:=xlPasteValues
                       Application.CutCopyMode = False
                       .Cells(n, "AB").EntireRow.Delete
                      i = i + 1
                  End If
              Next
          End With
          MissingInvCount = i - 1
      End If
  End If
  
  If Range("PB") = "Morgan Stanley" Then
  
  Worksheets("ms").Activate
  Set rng = ActiveSheet.Range("R1:R" &amp; Lastrow)
  search = "INV NOT FOUND"
  Set cell = rng.Find(What:=search, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
  
      If cell Is Nothing Then
          MsgBox ("There are no missing investments.")
      Else
          Set newSheet = ThisWorkbook.Sheets.Add
          Worksheets("ms").Activate
          i = 1
  
          With ActiveSheet
          On Error Resume Next
          Application.ScreenUpdating = False
              For n = nLastRow To nFirstRow Step -1
                  If .Cells(n, "R") = "INV NOT FOUND" Then
                      .Cells(n, "R").EntireRow.Copy
                       newSheet.Cells(i, "A").PasteSpecial Paste:=xlPasteValues
                       Application.CutCopyMode = False
                       .Cells(n, "R").EntireRow.Delete
                      i = i + 1
                  End If
              Next
          End With
          MissingInvCount = i - 1
      End If
  End If
  
  If MissingInvCount &lt;&gt; 0 Then
  MsgBox ("There are " &amp; MissingInvCount &amp; " missing investments.")
  End If
  
  'Sort Missing Investments tab
  If MissingInvCount &lt;&gt; 0 Then
  
      newSheet.Activate
      Lastrow = Cells(Rows.Count, 2).End(xlUp).Row
  
      If tWB.Worksheets("home").Range("PB") = "Citi" Then
          Range("A1:FN" &amp; Lastrow).SORT key1:=Range("DC1:DC" &amp; Lastrow), _
              order1:=xlAscending, Header:=xlNo
          Columns("DD:FN").EntireColumn.Delete
  
      ElseIf tWB.Worksheets("home").Range("PB") = "Pershing" Then
          Range("A1:CI" &amp; Lastrow).SORT key1:=Range("X1:X" &amp; Lastrow), _
              order1:=xlAscending, Header:=xlNo
          Columns("Y:FN").EntireColumn.Delete
  
      ElseIf tWB.Worksheets("home").Range("PB") = "JPM" Then
          Range("A1:CU" &amp; Lastrow).SORT key1:=Range("AJ1:AJ" &amp; Lastrow), _
              order1:=xlAscending, Header:=xlNo
          Columns("AK:CU").EntireColumn.Delete
  
      ElseIf tWB.Worksheets("home").Range("PB") = "Goldman Sachs" Then
       Range("A1:CJ" &amp; Lastrow).SORT key1:=Range("Y1:Y" &amp; Lastrow), _
           order1:=xlAscending, Header:=xlNo
       Columns("Z:CJ").EntireColumn.Delete
  
      ElseIf tWB.Worksheets("home").Range("PB") = "Morgan Stanley" Then
       Range("A1:BZ" &amp; Lastrow).SORT key1:=Range("O1:O" &amp; Lastrow), _
           order1:=xlAscending, Header:=xlNo
       Columns("P:BZ").EntireColumn.Delete
  
      End If
  
      'Save flat file
      Dim strFullname As String
      Dim strFullname2 As String
  
      strFullname = "G:\CMG\DCM\Operations\Monthly Cycle\Monthly Transaction Upload\" &amp; Range("PB") &amp; "\" &amp; Format(Range("CurrentDate"), "yyyy") &amp; "\Investments Pending Creation\" &amp; Range("PB") &amp; " " &amp; Format(Range("CurrentDate"), "mmddyy") &amp; ".csv"
      strFullname2 = "G:\CMG\DCM\Operations\Monthly Cycle\Monthly Transaction Upload\" &amp; Range("PB") &amp; "\" &amp; Format(Range("CurrentDate"), "yyyy") &amp; "\Ignored\" &amp; Range("PB") &amp; " " &amp; Format(Range("CurrentDate"), "mmddyy") &amp; ".csv"
  
      Application.DisplayAlerts = False
  
      ThisWorkbook.ActiveSheet.Move
      ActiveWorkbook.SaveAs Filename:=strFullname, FileFormat:=xlCSV, CreateBackup:=True
      ActiveWorkbook.Close
  
      ThisWorkbook.Worksheets("ignore").Copy
      ActiveWorkbook.SaveAs Filename:=strFullname2, FileFormat:=xlCSV, CreateBackup:=True
      ActiveWorkbook.Close
  
  End If
  
  Application.DisplayAlerts = True
  
  Application.ScreenUpdating = True
  
  Sheets("home").Activate
  
  End Sub
  </code></pre>
  
  <p>i would like to code to finish in under 5 minutes if possible.</p>