I have a macro here which is designed to combine and sum lines together in a worksheet if certain lines have similar entries. In my dataset:

Code Date Code2 Desc Ident Amount

A 10/1 A BIG 1 10

B 10/1 B TALL 2 20

A 10/2 A TALL 2 30

B 10/2 B FUNNY 3 40

A 10/1 A BIG 1 50

B 10/2 B FUNNY 3 60

The desired output should be:

Code Date Code2 Desc Ident Amount

A 10/1 A BIG 1 60

B 10/1 B TALL 2 20

A 10/2 A TALL 2 30

B 10/2 B FUNNY 3 100

That is, rows will combine and sum if columns 1, 2, and 5 all match. The code below seems to work on this small dataset, but when I move to a larger dataset, I get a type mismatch error. Here is the code I'm currently using. Any ideas?

Sub test()

Dim dic As Object, w(), y, z

Dim i As Long, ii As Long, n As Long

Set dic = CreateObject("Scripting.Dictionary")

With ActiveSheet

.Range("I1").Delete

.Range("H1").Delete

With .Range("a1").CurrentRegion

a = .Offset(1).Resize(.Rows.Count - 2).Value

End With

For i = LBound(a, 1) To UBound(a, 1)

If (a(i, 5)) = " " Then

n = n + 1: ReDim Preserve w(1 To UBound(a, 2), 1 To n)

For ii = LBound(a, 2) To UBound(a, 2)

w(ii, n) = a(i, ii)

Next

Else

z = a(i, 1) & ":" & a(i, 2) & ":" & a(i, 5)

If Not dic.exists(z) Then

n = n + 1: ReDim Preserve w(1 To UBound(a, 2), 1 To n)

For ii = LBound(a, 2) To UBound(a, 2)

w(ii, n) = a(i, ii)

Next

dic.Add z, n

Else

w(6, dic(z)) = w(6, dic(z)) + a(i, 6)

End If

End If

Next

Set dic = Nothing: Erase a

With .Range("a2")

With .CurrentRegion

.Offset(1).Resize(.Rows.Count + 10).ClearContents

End With

.Resize(UBound(w, 2), UBound(w, 1)) _

= Application.Transpose(w)

End With

With .Range("f65536").End(xlUp).Offset(1)

.Offset(, -1) = "Total"

.FormulaR1C1 = "=sum(r2c:r[-1]c)"

End With

End With

Erase w

End Sub

Thanks,

Howieebub