VBA code - need little help

Ismo

New Member
Joined
Jun 2, 2012
Messages
30
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.

Code:
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
 

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.
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?
 
Upvote 0
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!
 
Upvote 0
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
 
Upvote 0


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!
 
Upvote 0
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
 
Upvote 0
OK. That helps much better.

Try this one and see if it does what you want
Code:
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
 
Upvote 0
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.


excelconfigboardbeforet.jpg



excelconfigboardafterth.jpg
 
Last edited:
Upvote 0

Forum statistics

Threads
1,211,680
Messages
6,103,250
Members
447,850
Latest member
thebuzzman15

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top