Adding all IDs associated with a Fax to one Row
You could just use a dictionary to identify unique values, then use the dictionary to identify the matches and print them to the new sheet. This also eliminates the need for user input of &quot;How many unique items max&quot;.
Doing it this way won't require as much coding, or calling any functions. In fact, it does it in one fell swoop, which should speed it up when there's a large amount of data. You could use the dictionary to pull the items into an array and then print the array, but I'm not certain it would speed up significantly more on this solution.
The trick to the dictionary is that it can't have duplicate keys - so it's doing your entire uniqueitems() in a simple loop.
In faxestouse you're copying and pasting - instead just define the worksheets and set the values without any need to use .activate - this is much cleaner.
Sub CombineOtherID()
Dim dict As Object
Set dict = CreateObject(&quot;Scripting.Dictionary&quot;)

Dim lastrow As Integer
lastrow = Cells(Rows.Count, &quot;A&quot;).End(xlUp).Row

Dim strA As String

'Will use each fax number only once as a dictionary key
For i = 2 To lastrow
    strA = Cells(i, 2)
    dict(strA) = 1
Next

Dim countkey As Integer
countkey = 2
Dim countcol As Integer
Dim wsorigin As Worksheet
Set wsorigin = ActiveSheet
Dim wstarget As Worksheet
Set wstarget = Sheets(&quot;Use Me&quot;)

wstarget.Range(&quot;A1&quot;) = &quot;Faxes&quot;
wstarget.Range(&quot;B1&quot;) = &quot;Other IDs&quot;

'Use the keys to populate the target sheet
For Each Key In dict.keys
    wstarget.Cells(countkey, 1) = Key
    countkey = countkey + 1
    countcol = 2
        For j = 2 To lastrow
            If wsorigin.Cells(j, 2) Like Key Then
                wstarget.Cells(countkey - 1, countcol) = wsorigin.Cells(j, 1)
                countcol = countcol + 1
            End If
        Next
Next
End Sub


Otherwise
Now, if I were to go through your code there's a few things I'd note.
Your inputbox isn't handling any errors. I'd make sure it specifies the numeric type -
UniqueTotal = Application.InputBox(&quot;How Many Unique OtherIDs is Max?&quot;, Type:=1)

I'm a bit fuzzy how UniqueItems returns to subtotal. If it's a single integer, I guess it would work as a pretty inefficient loop, but as a variant - it should fail:
Next you call the UniqueItems() function which can return the number of uniques or an array of uniques. I'm not confident your matching algorithm is the most efficient - instead I'd use the dictionary object. It will give you the array or if you want the count you can use the .count method to get that.
If you return the count, then If SubTotal &gt; UniqueTotal will execute no problem as subtotal is long. If the UniqueItems returns a variant (array), you will get type mismatch when you set SubTotal = UniqueItems - so I'm not sure what your goal here is - you pass an array to a long to check if your function returns a value greater than user input - is this to check to see if the list is already only uniques? There must be a better way to do that.
Then you're going to use .copy and .paste with .activate to fill in your sheet, but again you call UniqueItems as True so you'll get numunique - which doesn't have a type but would work as an integer. However, if you call it with False you'll get an array passed to a long which would return a type mismatch.
As far as the inefficient loop goes -
For CurRow = 2 To LastRow
        SubTotal = UniqueItems(Range(&quot;A2:A&quot; &amp; CurRow))
        If SubTotal &gt; UniqueTotal Then
            SubTotal = UniqueItems(Range(&quot;A2:A&quot; &amp; CurRow - 1))
            Range(&quot;A1:B&quot; &amp; CurRow - 1).Copy
            Sheets(&quot;Use Me&quot;).Cells.Clear
            Sheets(&quot;Use Me&quot;).Range(&quot;A1&quot;).PasteSpecial xlPasteValues
            Sheets(&quot;Use Me&quot;).Activate
            MsgBox &quot;Use Me Sheet rows contain &quot; &amp; SubTotal &amp; &quot; Unique OtherIDs&quot;
            Exit Sub
        End If
        Cells(CurRow, 1).EntireRow.Interior.Color = RGB(255, 255, 0)
    Next CurRow

You will loop through everything until you count larger than the user input and then copy and paste the range - how does this work? Won't it just return the x number of rows, indiscriminately?  You might have an incomplete data set at this point on your new sheet.
I don't quite understand the RemoveDups() sub. I think it looks for duplicates in column B because you haven't reversed the array and column B is still Fax Numbers. But after that, I'm not sure how you're getting anywhere close to your output.