VBA code - need little help

[Ismo]

I've found this code, and it almost does perfectly what I'm after. My only problem is, that this code sums more cells than I wanted.

My raw data has 7 columns (A-G). I need to check the duplicates based on multiple cells (A-H) and sums up G.

This code does the job but it also sums up every data in D,E,F,G (I only need a summary in G).

I've fairly new to VBA and tried to play with the numbers, but I've only managed to clear the values in D,E,F,G.

Sub AB()
Dim a, i As Long, ii As Integer, b(), n As Long, z As String
With ActiveSheet.Range("a1").CurrentRegion
    a = .Value
    ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))
    For i = 1 To UBound(a, 2): b(1, i) = a(1, i): Next
    n = 1
    With CreateObject("Scripting.Dictionary")
        For i = 2 To UBound(a, 1)
            z = a(i, 1) & ";" & a(i, 2) & ";" & a(i, 3) & ";" & a(i, 4) & ";" & a(i, 5) & ";" & a(i, 6)
            If Not .exists(z) Then
                n = n + 1: .Add z, n
                For ii = 1 To 3: b(n, ii) = a(i, ii): Next
            End If
            For ii = 4 To UBound(a, 2)
                b(.Item(z), ii) = b(.Item(z), ii) + a(i, ii)
            Next
        Next
    End With
    .Value = b
End With
End Sub

 

[mirabeau]

I've found this code, and it almost does perfectly what I'm after. My only problem is, that this code sums more cells than I wanted.

My raw data has 7 columns (A-G). I need to check the duplicates based on multiple cells (A-H) and sums up G.

This code does the job but it also sums up every data in D,E,F,G (I only need a summary in G).

I've fairly new to VBA and tried to play with the numbers, but I've only managed to clear the values in D,E,F,G.

It's not hard to see what this code does, but it's harder to match it up with your explanation of what you want.

To save time and trouble, could you post a sample of your data, indicate specifically what you want done with it, indicate whether you specifically want a modification of Jindon/Seiya's code (the one you quoted), or whether another code giving the same result would suit you?

 

[duyanzhang]

Please post a sample of your data.

 

[Ismo]

For example:
A1=date B1=111222 C1=ABCD ... and G1=1
A2=date B2=111222 C2=ABC ... and G2=1
A3=date B3=111222 C3=ABCD ... and G3=2
A4=date B4=111222 C4=ABCD ... and G4=1
A5=date B5=222111 C4=ABCD ... and G5=1

And I would like to have my final date look like this:
A1=date B1=111222 C1=ABCD ... and G1=4
A2=date B2=111222 C2=ABC ... and G2=1
A3=date B5=222111 C4=ABCD ... and G5=1

Thanks in advance!

 

[mirabeau]

I'm afraid I'm unable to make any sense whatever out of your post #4.

What is it that you want?

Please post a sample of your worksheet, by one of the following:

- Want to post a small screen shot? Try one of these Excel jeanie, MrExcel HTML Maker or Borders-Copy-Paste

 

[Ismo]

I have to use at least B and C (I need both) or more to find out if these rows are identical. So in the code I'm checking A-F, and I would like to sum up only G.

Thanks for the help!

 

[GTO]

Hi Ismo,

I see that you just joined

Reference Mirabeau's request:

...Please post a sample of your worksheet, by one of the following:

- Want to post a small screen shot? Try one of these Excel jeanie, MrExcel HTML Maker or Borders-Copy-Paste

You see how anyone wishing to help would need to spend time recreating in Excel your picture?

Please provide the sample data and hopeful outcome in a usable manner. Does that make sense?

Mark

 

[mirabeau]

OK. That helps much better.

Try this one and see if it does what you want

Sub a_code()
Dim d As Object, a, n As Long
Dim u As String, i As Long, j As Long

Set d = CreateObject("scripting.dictionary")
d.comparemode = 1
a = Range("A1").CurrentRegion.Resize(, 7)
n = UBound(a, 1)
ReDim b(1 To n, 1 To 7)
For i = 2 To n
    u = a(i, 2) & Chr(30) & a(i, 3)
    If Not d.exists(u) Then
        d(u) = d.Count + 1
        For j = 1 To 6
            b(d(u), j) = a(i, j)
        Next j
        b(d(u), 7) = 1
    Else
        b(d(u), 7) = b(d(u), 7) + 1
    End If
Next i
Range("A2").Resize(n - 1, 7).ClearContents
Range("A2").Resize(d.Count, 7) = b
End Sub

 

[Ismo]

OK. That helps much better.

Try this one and see if it does what you want

That is exactly what I was after! Thank you very much, your help is so much appreciated!

 

[Ismo]

OK. That helps much better.

Try this one and see if it does what you want

I've tried with some different data and the sumary isn't correct. Could you please have a look on it?

I've attached the before and after state of the sheet.