type missmatch error in my macro

[osmanoca]

hello, i have word and meanings in two columns like dictionary. meanings are seperated with comma and i want to make every meaning a new row. so i use this code. it is working when i write a few rows to test. but it gives error in dictionary database. what is problem please look and help me...

my code so:

Sub SliceNDice()
Dim objRegex As Object
Dim X
Dim Y
Dim lngRow As Long
Dim lngCnt As Long
Dim tempArr() As String
Dim strArr
Set objRegex = CreateObject("vbscript.regexp")
objRegex.Pattern = "^\s+(.+?)$"
 'Define the range to be analysed
X = Range([a1], Cells(Rows.Count, "b").End(xlUp)).Value2
ReDim Y(1 To 2, 1 To 1000)
For lngRow = 1 To UBound(X, 1)
     'Split each string by ","
    tempArr = Split(X(lngRow, 2), ",")
    For Each strArr In tempArr
        lngCnt = lngCnt + 1
         'Add another 1000 records to resorted array every 1000 records
        If lngCnt Mod 1000 = 0 Then ReDim Preserve Y(1 To 2, 1 To lngCnt + 1000)
        Y(1, lngCnt) = X(lngRow, 1)
        Y(2, lngCnt) = objRegex.Replace(strArr, "$1")
    Next
Next lngRow
 'Dump the re-ordered range to columns C:D
[c1].Resize(lngCnt, 2).Value2 = Application.Transpose(Y)
End Sub

 

[Akuini]

You don’t need to try many different number, just use x = 1000000.
I tried using the data in your file. I copy 50.000 rows to sheet3 & then with sheet3 as the active sheet I ran the code (with x = 1000000). And it worked. The result in sheet2 is 887.903 rows.

 

[osmanoca]

my office is plus 2010 . can you send the result file and i think problem in office version..

 

[Akuini]

I don’t think it’s about Excel version. I’m using Excel 2007.

 

[mikerickson]

I think the issue is that with that much data, the number of columns of the array gets too large for Application.Transpose to handle.

 

[mikerickson]

Try this after adjusting rngSource and rngDestination

Sub test()
    Dim rngSource As Range, rngDestination As Range
    Dim arrInput As Variant, arrOutput() As String
    Dim i As Long, j As Long, Pointer As Long
    
    Set rngSource = Sheet1.Range("A1"): Rem adjust
    Set rngDestination = Sheet1.Range("D1"): Rem adjust
    
    Dim arrWords As Variant
    With rngSource
        arrInput = Range(.Cells.Resize(1, 2), .EntireColumn.Cells(Rows.Count, 1).End(xlUp)).Value
    End With
    
    ReDim arrOutput(1 To 10 * UBound(arrInput, 1), 1 To 2)
    
    For i = 1 To UBound(arrInput, 1)
        If arrInput(i, 1) <> vbNullString Then
            arrWords = Split(arrInput(i, 2), ",")
            For j = 0 To UBound(arrWords)
                Pointer = Pointer + 1
                arrOutput(Pointer, 1) = arrInput(i, 1)
                arrOutput(Pointer, 2) = arrWords(j)
            Next j
        End If
    Next i
    rngDestination.Resize(Pointer, 2).Value = arrOutput
End Sub

 

[osmanoca]

thanks very much firends. Akuini code was working but the problem is my data many rows numbers. Akuini converted data with that code. mikerickson also thanks very much. your latest code gives error 400. i dont know mean of that. but the problem is size my data. because in small size rows your codes was working. i installed new version office. i will try again in there. if i coudnt i will return again. see you dear friends . thanks again...

 

[mikerickson]

What line was highlighted when you got that error?