parscon
04-04-2012, 10:23 PM
I have a problem when use this macro , when run this macro on data in sheet show me this error and when click on debug show this line
If a(i, ii) <> "" Then
Run-time error '13':
Type mismatch
Option Explicit
Sub Merging_Duplicate()
Dim a, i As Long, ii As Long, n As Long, z As String, x As Long
a = Sheets("Sheet1").Range("a1").CurrentRegion.Value
n = 1
With CreateObject("Scripting.Dictionary")
.CompareMode = 1
For i = 2 To UBound(a, 1)
For ii = 1 To 1
z = z & Chr(2) & a(i, ii)
Next
If Not .exists(z) Then
n = n + 1: .Item(z) = n
For ii = 1 To UBound(a, 2)
a(n, ii) = a(i, ii)
Next
Else
x = .Item(z)
For ii = 2 To UBound(a, 2)
If a(i, ii) <> "" Then
a(x, ii) = a(x, ii) & IIf(a(x, ii) <> "", ", ", "") & a(i, ii)
End If
Next
End If
z = ""
Next
End With
On Error Resume Next
Application.DisplayAlerts = False
Sheets("Results").Delete
On Error GoTo 0
Sheets.Add().Name = "Results"
With Sheets("Results").Cells(1).Resize(n, UBound(a, 2))
.Value = a
End With
End Sub
Also I attached The workBook .
I use Excel 2010 x64 and windows 7 x64
If a(i, ii) <> "" Then
Run-time error '13':
Type mismatch
Option Explicit
Sub Merging_Duplicate()
Dim a, i As Long, ii As Long, n As Long, z As String, x As Long
a = Sheets("Sheet1").Range("a1").CurrentRegion.Value
n = 1
With CreateObject("Scripting.Dictionary")
.CompareMode = 1
For i = 2 To UBound(a, 1)
For ii = 1 To 1
z = z & Chr(2) & a(i, ii)
Next
If Not .exists(z) Then
n = n + 1: .Item(z) = n
For ii = 1 To UBound(a, 2)
a(n, ii) = a(i, ii)
Next
Else
x = .Item(z)
For ii = 2 To UBound(a, 2)
If a(i, ii) <> "" Then
a(x, ii) = a(x, ii) & IIf(a(x, ii) <> "", ", ", "") & a(i, ii)
End If
Next
End If
z = ""
Next
End With
On Error Resume Next
Application.DisplayAlerts = False
Sheets("Results").Delete
On Error GoTo 0
Sheets.Add().Name = "Results"
With Sheets("Results").Cells(1).Resize(n, UBound(a, 2))
.Value = a
End With
End Sub
Also I attached The workBook .
I use Excel 2010 x64 and windows 7 x64