PLEASE HELP!!VBA CODE: Selecting Duplicates and Copying Unique Values

[BitterPatter]

I am trying to make my macro open a new workbook and paste all the rows that have duplicate values. I want it to create a new workbook for each set of duplicate values.More specifically, My code is suppose to select cells based on a datediff value of 2, group all the cells with the same unique Identifier together, then copy and paste it into a new workbook.For instance if the cell values were,​

<code style="margin: 0px; padding: 0px; border: 0px; vertical-align: baseline; font-family: Consolas, Menlo, Monaco, 'Lucida Console', 'Liberation Mono', 'DejaVu Sans Mono', 'Bitstream Vera Sans Mono', 'Courier New', monospace, serif; white-space: inherit; ">
A1= 1234 B1= 2
A2= 1234 B2= 5
A3= 321 B3= 7
A4= 234 B4= 2
A5= 234 B5= 2


</code>

The macro would copy the entire row for A1 then paste it into a new workbook and then copy the entire row of A4 and A5 and paste it into another new workbook, because those are the cells that have column B= 2. It would do this until no values are left in the columns.The problem with my code, is that it opens 10+ Different new workbooks, some with values some without. The first few does what I wanted but the last few are blank. Any Help would be amazing and truly appreciated!​

<code style="margin: 0px; padding: 0px; border: 0px; vertical-align: baseline; font-family: Consolas, Menlo, Monaco, 'Lucida Console', 'Liberation Mono', 'DejaVu Sans Mono', 'Bitstream Vera Sans Mono', 'Courier New', monospace, serif; white-space: inherit; ">
My Code is as followed,

Sub test()
Dim wbNew As Workbook
lr = Range("A" & Rows.Count).End(xlUp).Row
myarr = uniqueValues(Range("A1:A" & lr))
For i = LBound(myarr) To UBound(myarr)

With Sheet1
.AutoFilterMode = False
.Range("A1").AutoFilter Field:=1, Criteria1:=myarr(i)
.AutoFilter.Range.EntireRow.Copy
Set wbNew = Workbooks.Add()
wbNew.Worksheets(1).Paste

Workbooks("Workbook2.xlsm").Sheets("Invoice Template (2)").Copy Before:=wbNew.Sheets(1)
ActiveSheet.Name = "Current Invoice"

Dim s As Integer
s = 2

Dim t As Integer
t = 21

wbNew.Worksheets(2).Activate

Do Until IsEmpty(Cells(s, 3))
mini = Cells(s, 21).Value
If mini = "2" Then

Dim wsInvoice As Worksheet
Set wsInvoice = wbNew.Sheets("Current Invoice")

wsInvoice.Cells(t, 2).Value = Cells(s, 10).Value 'Volumes'
wsInvoice.Cells(t, 3).Value = Cells(s, 8).Value 'Benefits'
wsInvoice.Cells(t, 7).Value = Cells(s, 11).Value 'Rates'
wsInvoice.Cells(8, 2).Value = Cells(s, 14).Value 'Insurer Name'
wsInvoice.Cells(9, 2).Value = Cells(s, 16).Value 'Insurer Address'
wsInvoice.Cells(13, 2).Value = Cells(s, 3).Value 'Client Name'
wsInvoice.Cells(14, 2).Value = Cells(s, 4).Value 'Client Address'
wsInvoice.Cells(10, 9).Value = Cells(s, 1).Value 'Policy Number'
wsInvoice.Cells(11, 9).Value = Cells(s, 22).Value 'Renewal Date'
wsInvoice.Cells(12, 9).Value = Cells(s, 20).Value 'Anniversary Date'

With wsInvoice
Select Case Cells(s, 9)
Case 1001 'Formula for Life, AD & D, ASI, CI'
Prem = (.Cells(t, 2) * .Cells(t, 7)) / 1000
Case 1103 'Formula for LTD'
Prem = (.Cells(t, 2) * .Cells(t, 7)) / 100
Case 1104 'Formula for STD'
Prem = (.Cells(t, 2) * .Cells(t, 7)) / 10
Case 2112 'General Formula'
Prem = (.Cells(t, 2) * .Cells(t, 7))
End Select

.Cells(t, 9).Value = Prem
End With

With wsInvoice
Select Case Cells(s, 15)
Case 5501 'Commission schedule AIG'

Case 5502 'Commission schedule ACE INA'

Case 5503 'Commission schedule BBD'
FrontL = 1
HBack = 0
Case 5504 'Commission schedule CBA'

Case 5505 'Commission schedule ENCON'

Case 5506 'Commission schedule Fenchurch'
FrontL = 1
HBack = 0
Case 5507 'Commission schedule Great West Life'
FrontL = 1
HBack = 0
Case 5508 'Commission schedule Great West Life SelectPac'
FrontL = 1
HBack = 0
Case 5509 'Commission schedule Greenshield Canada'

Case 5510 'Commission schedule GHG'

Case 5511 'Commsion Schedule Industrial Alliance'
FrontL = 0.9
HBack = 0.1
Case 5512 'Commission schedule Manulife'
FrontL = 0.9
HBack = 0.1
Case 5513 'Commission schedule RBC'
FrontL = 0.8
HBack = 0.2
Case 5514 'Commission schedule SunAdvantage'
FrontL = 0.9
HBack = 0.1
Comm = 0.06
Case 5515 'Commission schedule Sun Life Financial'
FrontL = 0.9
HBack = 0.1
Comm = 0.1
End Select

.Cells(38, 8).Value = FrontL
.Cells(39, 8).Value = HBack
.Cells(18, 4).Value = Comm
End With

t = t + 1

End If


s = s + 1

Loop

End With


Next i
End Sub


Dim cell As Range
Dim tempList As Variant: tempList = ""
For Each cell In InputRange
If cell.Value <> "" Then
If InStr(1, tempList, cell.Value) = 0 Then
If tempList = "" Then tempList = Trim(CStr(cell.Value)) Else tempList = tempList & "|" & Trim(CStr(cell.Value))
End If
End If
Next cell
uniqueValues = Split(tempList, "|")
End Function



</code>