Hello I'm trying to run the script below on the data shown in the "raw" sheet of the attached workbook. When I run it on just the first 5-10 rows, it works just fine as shown in the "intended" sheet. When I try to run it on the full 30,000, I get a "run time error 1004" and this line is flagged in the debugger: Cells(1, "H").Resize(nIndex, 2) = sNames. Can anyone figure out why the script is dying when run on the 30,000 rows? Thanks for any help!
Sub x()
Dim rInput As Range, oDic As Object, sNames() As String, vInput()
Dim i As Long, nIndex As Long
Set rInput = Range("A1", Range("B65536").End(xlUp))
vInput = rInput.Value
ReDim sNames(1 To UBound(vInput, 1), 1 To 2)
Set oDic = CreateObject("Scripting.Dictionary")
With oDic
For i = 1 To UBound(vInput, 1)
If Not .Exists(vInput(i, 1)) Then
nIndex = nIndex + 1
sNames(nIndex, 1) = vInput(i, 1)
sNames(nIndex, 2) = vInput(i, 2)
.Add vInput(i, 1), nIndex
ElseIf .Exists(vInput(i, 1)) Then
sNames(.Item(vInput(i, 1)), 2) = sNames(.Item(vInput(i, 1)), 2) & ", " & vInput(i, 2)
End If
Next i
End With
Cells(1, "H").Resize(nIndex, 2) = sNames
' The line below if you want the words in separate columns
' otherwise they are in a single cell, separated by commas
Cells(1, "I").Resize(nIndex).TextToColumns , comma:=True
End Sub
Bookmarks