title: Trying to have a messagebox run code from a separate procedure
body: <p>I have about 2500 lines of code. I realize I need to break my code up into procedures but am not sure how to do so. Is there a way to have a message box from the first procedure run from a second procedure? Error im getting is "Procedure too long"</p>
  
  <pre><code>Sub Matt_Liam()
  
  
      Dim ws1 As Worksheet
      Set ws1 = ThisWorkbook.Sheets.Add(After:= _
               ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
  
      Dim ws2 As Worksheet
      Set ws2 = ThisWorkbook.Sheets.Add(After:= _
               ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
  
      Dim ws3 As Worksheet
      Set ws3 = ThisWorkbook.Sheets.Add(After:= _
               ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
  
      Dim ws4 As Worksheet
      Set ws4 = ThisWorkbook.Sheets.Add(After:= _
               ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
  
      Dim ws5 As Worksheet
      Set ws5 = ThisWorkbook.Sheets.Add(After:= _
               ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
  
  
      Dim ws6 As Worksheet
      Set ws6 = ThisWorkbook.Sheets.Add(After:= _
               ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
  
  
  Dim rwqty2 As Long, lastrowqty2 As Long, MySelqty2 As Range 'Grabs skus and moves to new sheet
  
  With Worksheets("orders (3)")
      For rwqty2 = 1000 To 2 Step -1
          If .Cells(rwqty2, 25).Value Like "*2*" Then
              If MySelqty2 Is Nothing Then
                  Set MySelqty2 = .Cells(rwqty2, 1).EntireRow
  
                      Else
                          Set MySelqty2 = Union(MySelqty2, .Cells(rwqty2, 1).EntireRow)
  
                      End If
                  End If
              Next rwqty2
          End With
  
  With ThisWorkbook.Worksheets("orders (3)")
      lastrowqty2 = .Cells(.Rows.Count, 1).End(xlUp).Row
      If Not MySelqty2 Is Nothing Then
          MySelqty2.Copy Destination:=.Cells(lastrowqty2 + 1, 1)
          'MySelqty3.Delete
      End If
  End With
  
  
  Dim rwqty3 As Long, lastrowqty3 As Long, MySelqty3 As Range 'Grabs skus and moves to new sheet
  
  With Worksheets("orders (3)")
      For rwqty3 = 1000 To 2 Step -1
          If .Cells(rwqty3, 25).Value Like "*3*" Then
              If MySelqty3 Is Nothing Then
                  Set MySelqty3 = .Cells(rwqty3, 1).EntireRow
  
                      Else
                          Set MySelqty3 = Union(MySelqty3, .Cells(rwqty3, 1).EntireRow)
  
                      End If
                  End If
              Next rwqty3
          End With
  
  With ThisWorkbook.Worksheets("orders (3)")
      lastrowqty3 = .Cells(.Rows.Count, 1).End(xlUp).Row
      If Not MySelqty3 Is Nothing Then
          MySelqty3.Copy Destination:=.Cells(lastrowqty3 + 1, 1)
          'MySelqty3.Delete
      End If
  End With
  
  With ThisWorkbook.Worksheets("orders (3)")
      lastrowqty3 = .Cells(.Rows.Count, 1).End(xlUp).Row
      If Not MySelqty3 Is Nothing Then
          MySelqty3.Copy Destination:=.Cells(lastrowqty3 + 1, 1)
          'MySelqty3.Delete
      End If
  End With
  
  
       Worksheets("orders (3)").Range("X1:AO300").Cut Worksheets("orders (3)").Range("Z1:AQ300") 'Makes room for texttocolumns
  
          Dim objRange1 As Range
      With Workbooks("orders (3).xlsx").Worksheets("orders (3)")
          Set objRange1 = .Range("W1:W300")
          objRange1.TextToColumns _
          Destination:=.Range("W1"), _
          DataType:=xlDelimited, _
          Tab:=False, _
          Semicolon:=False, _
          Comma:=False, _
          Space:=False, _
          Other:=True, _
          OtherChar:="|"
      End With
  
  
      Worksheets("orders (3)").Range("A1:AY300").Copy Worksheets("Sheet1").Range("A1:AY300") 'moves to sheet1
  
      Workbooks("orders (3)").Worksheets("Sheet1").Range("A:U").Clear  'clears uneeded columns in Sheet1 workbook
      Workbooks("orders (3)").Worksheets("Sheet1").Range("AB:AC").Clear
      Workbooks("orders (3)").Worksheets("Sheet1").Range("AE:AE").Clear
      Workbooks("orders (3)").Worksheets("Sheet1").Range("AG:AY").Clear
  
      Workbooks("orders (3)").Worksheets("Sheet1").Range("Z:Z").Cut _
      Workbooks("orders (3)").Worksheets("Sheet1").Range("A:A")  'cleans up prodcution workbook
  
      Workbooks("orders (3)").Worksheets("Sheet1").Range("X:X").Cut _
      Workbooks("orders (3)").Worksheets("Sheet1").Range("B:B")  'cleans up prodcution workbook
  
  
      Workbooks("orders (3)").Worksheets("Sheet1").Range("Y:Y").Cut _
      Workbooks("orders (3)").Worksheets("Sheet1").Range("D:D")  'cleans up prodcution workbook
  
      Workbooks("orders (3)").Worksheets("Sheet1").Range("AD:AD").Cut _
      Workbooks("orders (3)").Worksheets("Sheet1").Range("F:F")  'cleans up prodcution workbook
  
      Workbooks("orders (3)").Worksheets("Sheet1").Range("V:V").Cut _
      Workbooks("orders (3)").Worksheets("Sheet1").Range("I:I")  'cleans up prodcution workbook
  
      Workbooks("orders (3)").Worksheets("Sheet1").Range("W:W").Cut _
      Workbooks("orders (3)").Worksheets("Sheet1").Range("J:J")  'cleans up prodcution workbook
  
      Workbooks("orders (3)").Worksheets("Sheet1").Range("AF:AF").Cut _
      Workbooks("orders (3)").Worksheets("Sheet1").Range("L:L")  'cleans up prodcution workbook
  
  
  Dim rw11 As Long
  
  With Worksheets("Sheet1")
      For rw11 = 1000 To 2 Step -1
          If .Cells(rw11, 6).Value Like "*Last Name:*" Then
  
              Dim objRange11 As Range
      With Workbooks("orders (3)").Worksheets("Sheet1")
          Set objRange11 = .Range("F1:F300")
          objRange11.TextToColumns _
          Destination:=.Range("F1"), _
          DataType:=xlDelimited, _
          Tab:=False, _
          Semicolon:=False, _
          Comma:=False, _
          Space:=False, _
          Other:=True, _
          OtherChar:="|"
      End With
  
  
  
              End If
          Next rw11
      End With
  
  
      Dim rw12 As Long
  
  For rw12 = 1000 To 1 Step -1
      With Worksheets("Sheet1")
          If .Cells(rw12, 6).Value Like "*Player Number*" Then
              .Cells(rw12, 6).Cut Destination:=.Cells(Rows.Count, 7).End(xlUp)(2)
              .Cells(rw12, 6).Delete (xlUp)
          End If
      End With
  Next
  
  
     Worksheets("Sheet1").Range("G1:L300").Cut Worksheets("Sheet1").Range("H1:M300")
  
  
  
      Dim objRange2 As Range
      With Workbooks("orders (3)").Worksheets("Sheet1")
          Set objRange2 = .Range("B1:B300")
          objRange2.TextToColumns _
          Destination:=.Range("B1"), _
          DataType:=xlDelimited, _
          Tab:=False, _
          Semicolon:=False, _
          Comma:=False, _
          Space:=False, _
          Other:=True, _
          OtherChar:=":"
      End With
  
      Dim objRange3 As Range
      With Workbooks("orders (3)").Worksheets("Sheet1")
          Set objRange3 = .Range("D1:D300")
          objRange3.TextToColumns _
          Destination:=.Range("D1"), _
          DataType:=xlDelimited, _
          Tab:=False, _
          Semicolon:=False, _
          Comma:=False, _
          Space:=False, _
          Other:=True, _
          OtherChar:=":"
      End With
  
      Dim objRange4 As Range
      With Workbooks("orders (3)").Worksheets("Sheet1")
          Set objRange4 = .Range("F1:F300")
          objRange4.TextToColumns _
          Destination:=.Range("F1"), _
          DataType:=xlDelimited, _
          Tab:=False, _
          Semicolon:=False, _
          Comma:=False, _
          Space:=False, _
          Other:=True, _
          OtherChar:=":"
      End With
  
      Dim objRange5 As Range
      With Workbooks("orders (3)").Worksheets("Sheet1")
          Set objRange5 = .Range("H1:H300")
          objRange5.TextToColumns _
          Destination:=.Range("H1"), _
          DataType:=xlDelimited, _
          Tab:=False, _
          Semicolon:=False, _
          Comma:=False, _
          Space:=False, _
          Other:=True, _
          OtherChar:=":"
      End With
  
      Dim objRange6 As Range
      With Workbooks("orders (3)").Worksheets("Sheet1")
          Set objRange6 = .Range("K1:K300")
          objRange6.TextToColumns _
          Destination:=.Range("K1"), _
          DataType:=xlDelimited, _
          Tab:=False, _
          Semicolon:=False, _
          Comma:=False, _
          Space:=False, _
          Other:=True, _
          OtherChar:=":"
      End With
  
  
      Worksheets("Sheet1").Range("B:B").Clear
      Worksheets("Sheet1").Range("D:D").Clear
      Worksheets("Sheet1").Range("F:F").Clear
      Worksheets("Sheet1").Range("H:H").Clear
      Worksheets("Sheet1").Range("K:K").Clear
  
      Workbooks("orders (3)").Worksheets("Sheet1").Range("C:C").Cut _
      Workbooks("orders (3)").Worksheets("Sheet1").Range("B:B")  'cleans up prodcution workbook
      Workbooks("orders (3)").Worksheets("Sheet1").Range("E:E").Cut _
      Workbooks("orders (3)").Worksheets("Sheet1").Range("C:C")  'cleans up prodcution workbook
      Workbooks("orders (3)").Worksheets("Sheet1").Range("G:G").Cut _
      Workbooks("orders (3)").Worksheets("Sheet1").Range("D:D")  'cleans up prodcution workbook
      Workbooks("orders (3)").Worksheets("Sheet1").Range("I:I").Cut _
      Workbooks("orders (3)").Worksheets("Sheet1").Range("E:E")  'cleans up prodcution workbook
      Workbooks("orders (3)").Worksheets("Sheet1").Range("J:J").Cut _
      Workbooks("orders (3)").Worksheets("Sheet1").Range("F:F")  'cleans up prodcution workbook
      Workbooks("orders (3)").Worksheets("Sheet1").Range("L:L").Cut _
      Workbooks("orders (3)").Worksheets("Sheet1").Range("G:G")  'cleans up prodcution workbook
      Workbooks("orders (3)").Worksheets("Sheet1").Range("M:M").Cut _
      Workbooks("orders (3)").Worksheets("Sheet1").Range("H:H")  'cleans up prodcution workbook
  
  Dim rw As Long, lastrow As Long, MySel As Range 'Grabs skus and moves to new sheet
  
  With Worksheets("Sheet1")
      For rw = 1000 To 2 Step -1
          If .Cells(rw, 1).Value Like "*11-*" Then
              If MySel Is Nothing Then
                  Set MySel = .Cells(rw, 1).EntireRow
  
                      Else
                          Set MySel = Union(MySel, .Cells(rw, 1).EntireRow)
  
                      End If
                  End If
              Next rw
          End With
  
  With ThisWorkbook.Worksheets("Sheet2")
      lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
      If Not MySel Is Nothing Then
          MySel.Copy Destination:=.Cells(lastrow + 1, 1)
          'MySel.Delete
      End If
  End With
  
  Dim rw1 As Long, lastrow1 As Long, MySel1 As Range 'Grabs skus and moves to new sheet
  
  With Worksheets("Sheet1")
      For rw1 = 1000 To 2 Step -1
          If .Cells(rw1, 1).Value Like "*22-*" Then
              If MySel1 Is Nothing Then
                  Set MySel1 = .Cells(rw1, 1).EntireRow
  
                      Else
                          Set MySel1 = Union(MySel1, .Cells(rw1, 1).EntireRow)
  
                      End If
                  End If
              Next rw1
          End With
  
  With ThisWorkbook.Worksheets("Sheet3")
      lastrow1 = .Cells(.Rows.Count, 1).End(xlUp).Row
      If Not MySel1 Is Nothing Then
          MySel1.Copy Destination:=.Cells(lastrow1 + 1, 1)
          'MySel1.Delete
      End If
  End With
  
  
  Dim rw2 As Long, lastrow2 As Long, MySel2 As Range 'Grabs skus and moves to new sheet
  
  With Worksheets("Sheet1")
      For rw2 = 1000 To 2 Step -1
          If .Cells(rw2, 1).Value Like "*33-*" Then
              If MySel2 Is Nothing Then
                  Set MySel2 = .Cells(rw2, 1).EntireRow
  
                      Else
                          Set MySel2 = Union(MySel2, .Cells(rw2, 1).EntireRow)
  
                      End If
                  End If
              Next rw2
          End With
  
  With ThisWorkbook.Worksheets("Sheet4")
      lastrow2 = .Cells(.Rows.Count, 1).End(xlUp).Row
      If Not MySel2 Is Nothing Then
          MySel2.Copy Destination:=.Cells(lastrow2 + 1, 1)
          'MySel2.Delete
      End If
  End With
  
  
  Dim rw3 As Long, lastrow3 As Long, MySel3 As Range 'Grabs skus and moves to new sheet
  
  With Worksheets("Sheet1")
      For rw3 = 1000 To 2 Step -1
          If .Cells(rw3, 1).Value Like "*44-*" Then
              If MySel3 Is Nothing Then
                  Set MySel3 = .Cells(rw3, 1).EntireRow
  
                      Else
                          Set MySel3 = Union(MySel3, .Cells(rw3, 1).EntireRow)
  
                      End If
                  End If
              Next rw3
          End With
  
  With ThisWorkbook.Worksheets("Sheet5")
      lastrow3 = .Cells(.Rows.Count, 1).End(xlUp).Row
      If Not MySel3 Is Nothing Then
          MySel3.Copy Destination:=.Cells(lastrow3 + 1, 1)
          'Mysel3.Delete
      End If
  End With
  
  Dim rw4 As Long, lastrow4 As Long, MySel4 As Range 'Grabs skus and moves to new sheet
  
  With Worksheets("Sheet1")
      For rw4 = 1000 To 2 Step -1
          If .Cells(rw4, 1).Value Like "*55-*" Then
              If MySel4 Is Nothing Then
                  Set MySel4 = .Cells(rw4, 1).EntireRow
  
                      Else
                          Set MySel4 = Union(MySel4, .Cells(rw4, 1).EntireRow)
  
                      End If
                  End If
              Next rw4
          End With
  
  With ThisWorkbook.Worksheets("Sheet6")
      lastrow4 = .Cells(.Rows.Count, 1).End(xlUp).Row
      If Not MySel4 Is Nothing Then
          MySel4.Copy Destination:=.Cells(lastrow4 + 1, 1)
          'MySel4.Delete
      End If
  End With
  
  
      Workbooks.Open Filename:="C:\CODE\11 Production.xlsx"
      Workbooks.Open Filename:="C:\CODE\22 Production.xlsx"
      Workbooks.Open Filename:="C:\CODE\33 Production.xlsx"
      Workbooks.Open Filename:="C:\CODE\44 Production.xlsx"
      Workbooks.Open Filename:="C:\CODE\55 Production.xlsx"
  
  
      Dim Rng As Range
      Set Rng = ThisWorkbook.Worksheets("Sheet2").Range("A1:AY300")
      Rng.Copy
  
      Dim s11 As Workbook
      Set s11 = Workbooks("11 Production")
      Dim last As Long
      Dim Rngnew As Range
  
  With s11.Sheets("Sheet1")
      If Application.WorksheetFunction.CountA(.Cells) &lt;&gt; 0 Then
          last = .Range("A65000").End(xlUp).Offset(1, 0).Row
      Else
          last = 1
      End If
  End With
      Set Rngnew = s11.Worksheets("Sheet1").Range("A" &amp; last)
  
      Rngnew.PasteSpecial
  
  
      Dim Rng22 As Range
      Set Rng22 = ThisWorkbook.Worksheets("Sheet3").Range("A1:AY300")
      Rng22.Copy
  
      Dim s22 As Workbook
      Set s22 = Workbooks("22 Production")
      Dim last22 As Long
      Dim Rng22new As Range
  
  With s22.Sheets("Sheet1")
      If Application.WorksheetFunction.CountA(.Cells) &lt;&gt; 0 Then
          last22 = .Range("A65000").End(xlUp).Offset(1, 0).Row
      Else
          last22 = 1
      End If
  End With
      Set Rng22new = s22.Worksheets("Sheet1").Range("A" &amp; last)
  
      Rng22new.PasteSpecial
  
          Dim Rng33 As Range
      Set Rng33 = ThisWorkbook.Worksheets("Sheet4").Range("A1:AY300")
      Rng33.Copy
  
      Dim s33 As Workbook
      Set s33 = Workbooks("33 Production")
      Dim last33 As Long
      Dim Rng33new As Range
  
  
  With s33.Sheets("Sheet1")
      If Application.WorksheetFunction.CountA(.Cells) &lt;&gt; 0 Then
          last33 = .Range("A65000").End(xlUp).Offset(1, 0).Row
      Else
          last33 = 1
      End If
  End With
      Set Rng33new = s33.Worksheets("Sheet1").Range("A" &amp; last)
  
      Rng33new.PasteSpecial
  
  
  
      Dim Rng44 As Range
      Set Rng44 = ThisWorkbook.Worksheets("Sheet5").Range("A1:AY300")
      Rng44.Copy
  
      Dim s44 As Workbook
      Set s44 = Workbooks("44 Production")
      Dim last44 As Long
      Dim Rng44new As Range
  
  With s44.Sheets("Sheet1")
      If Application.WorksheetFunction.CountA(.Cells) &lt;&gt; 0 Then
          last44 = .Range("A65000").End(xlUp).Offset(1, 0).Row
      Else
          last44 = 1
      End If
  End With
      Set Rng44new = s44.Worksheets("Sheet1").Range("A" &amp; last)
  
      Rng44new.PasteSpecial
  
  
      Dim Rng55 As Range
      Set Rng55 = ThisWorkbook.Worksheets("Sheet6").Range("A1:AY300")
      Rng55.Copy
  
      Dim s55 As Workbook
      Set s55 = Workbooks("55 Production")
      Dim last55 As Long
      Dim Rng55new As Range
  
  With s55.Sheets("Sheet1")
      If Application.WorksheetFunction.CountA(.Cells) &lt;&gt; 0 Then
          last55 = .Range("A65000").End(xlUp).Offset(1, 0).Row
      Else
          last55 = 1
      End If
  End With
      Set Rng55new = s55.Worksheets("Sheet1").Range("A" &amp; last)
  
      Rng55new.PasteSpecial
  
  
  
  
  
      If MsgBox("Would you like to populate the team lists?", vbOKCancel) = vbOK Then
      'run your code
  
      Workbooks("11 Production").Activate
          Dim newRwChr As Long
  
      With Worksheets("Sheet1")
      For newRwChr = 1000 To 2 Step -1
          If Right(.Cells(newRwChr, 3).Value, 1) = Chr(34) Then
              .Cells(newRwChr, 3).Value = Left(.Cells(newRwChr, 3).Value, Len(.Cells(newRwChr, 3).Value) - 1)
          End If
      Next newRwChr
      End With
  
  
  
      Dim newRw As Long, NewRngRow As Long, NewMySel As Range 'Grabs skus and moves to new sheet
      Dim News11 As Workbook
  
      With Worksheets("Sheet1")
          For newRw = 1000 To 2 Step -1
              If .Cells(newRw, 2).Value Like "*Minor Novice*" And .Cells(newRw, 3).Value Like ("*AE*") Then
                  If NewMySel Is Nothing Then
                      Set NewMySel = .Cells(newRw, 1).EntireRow
  
                          Set News11 = Workbooks.Open(Filename:="C:\CODE\Team Lists\11 Minor Novice AE.xlsx")
  
                          Else
                              Set NewMySel = Union(NewMySel, .Cells(newRw, 1).EntireRow)
  
                          End If
                      End If
                  Next newRw
              End With
  
      Workbooks("11 Production").Activate
  
  
      With Workbooks("11 Production").Worksheets("M Novice AE")
          NewRngRow = .Cells(.Rows.Count, 1).End(xlUp).Row
          If Not NewMySel Is Nothing Then
              NewMySel.Copy Destination:=.Cells(NewRngRow + 1, 1)
              'NewMySel.Delete
          End If
      End With
  If Not News11 Is Nothing Then
      Dim NewRng As Range
      Set NewRng = Workbooks("11 Production").Worksheets("M Novice AE").Range("A1:AY300")
      NewRng.Copy
      Dim NewLast As Long
      Dim NewRngnew As Range
  
  With News11.Sheets("Sheet1")
      If Application.WorksheetFunction.CountA(.Cells) &lt;&gt; 0 Then
          NewLast = .Range("A65000").End(xlUp).Offset(1, 0).Row
      Else
          NewLast = 1
      End If
  End With
      Set NewRngnew = News11.Worksheets("Sheet1").Range("A" &amp; NewLast)
  
      NewRngnew.PasteSpecial
  
      End If
  </code></pre>
  
  <p>The part is the message box repeats 50 times for different criteria</p>