title: Split worksheet in multiple workbooks based on unique values in range
body: <p>It's been asked before but I haven't found a solution for unique values, I'm trying to split a large worksheet into workbooks based on the unique supervisors of T column, which contains the one in charge (one to many relationship / multiple employees for a supervisor).</p>
  <p>My code currently scans the T column and runs the second code block to store and paste the rows associated to this person, the problem is that the loops runs for each row, no matter if the supervisor repeats itself 1000+ times, meaning that for each supervisor the file it's created <code>n</code> times.</p>
  <pre><code>emp       sup
  -------------------
  john doe  jane q public 'specific file for this supervisor
  clint     jane q public 'it should be in the same file as the prev record
  jenny doe jonny cage 'in separate file
  </code></pre>
  <p>Here's my code based on multiple answers on SO:</p>
  <pre><code>Option Explicit
  'Split resp data into separate columns based on the names defined in
  'a RESP on the FIRST sheet.
  Sub splitRespVP()
      Dim wb As Workbook
      Dim p As Range
  
      'Application.ScreenUpdating = False
      
      Application.DisplayAlerts = False
      Application.EnableEvents = False
  
      For Each p In Sheets(1).Range(&quot;T2:T2201&quot;)
          Workbooks.Add
          Set wb = ActiveWorkbook
          ThisWorkbook.Activate
  
          WritePersonToWorkbook wb, p.Value
  
          wb.SaveAs ThisWorkbook.Path &amp; &quot;\sdoRespVP_&quot; &amp; p.Value
          wb.Close
      Next p
      'Application.ScreenUpdating = True
      Set wb = Nothing
      
      Application.DisplayAlerts = True
      Application.EnableEvents = True
      
  End Sub
  </code></pre>
  <p>Second code loop, where the file it's recreated multiple times for each duplicated supervisor:</p>
  <pre><code>'Writes all the sales data rows belonging to a Person
  'to the first sheet in the named respWB.
  Sub WritePersonToWorkbook(ByVal respWB As Workbook, _
                            ByVal Person As String)
      Dim rw As Range
      Dim personRows As Range     'Stores all of the rows found
      Dim firstRW As Range        'containing Person in column 1
      For Each rw In UsedRange.Rows
          If Person = rw.Cells(2, 20) Then
              If personRows Is Nothing Then
                  Set personRows = rw
                  'Set personRows = Union(personRows, rw)
              Else
                  Set personRows = Union(personRows, rw)
              End If
          End If
      Next rw
  
      personRows.Copy respWB.Sheets(1).Cells(1, 1) ' ACA ESTÀ EL ERROR
      Set personRows = Nothing
  End Sub
  </code></pre>
  <p>I'm looking to avoid looping each row and work on unique values.</p>