hi all!
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
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