Consolidating data from multiple lines of a sheet (Excel 2007)

elflapo

New Member
Joined
Jul 17, 2012
Messages
11
Hi there, hope someone can help me with this query. (Apologies if this is not the standard way for submitting but it’s my first go). I’ve seen some examples here and I think I understand the consolidation function. However, my query has the added level of needing to consolidate each member:</SPAN></SPAN>
I have a table of data that looks like this:</SPAN></SPAN>
SURNAME</SPAN></SPAN>
NINO</SPAN></SPAN>
CODE</SPAN></SPAN>
NO OF UNITS</SPAN></SPAN>
Smith</SPAN></SPAN>
AB123456C</SPAN></SPAN>
8AIA</SPAN></SPAN>
1986.4805</SPAN></SPAN>
Smith</SPAN></SPAN>
AB123456C</SPAN></SPAN>
8AIA</SPAN></SPAN>
291.9253</SPAN></SPAN>
Smith</SPAN></SPAN>
AB123456C</SPAN></SPAN>
HEEINC</SPAN></SPAN>
8137.0435</SPAN></SPAN>
Smith</SPAN></SPAN>
AB123456C</SPAN></SPAN>
HEEINC</SPAN></SPAN>
1607.9067</SPAN></SPAN>
Smith</SPAN></SPAN>
AB123456C</SPAN></SPAN>
IQSBI</SPAN></SPAN>
9999.7594</SPAN></SPAN>
Smith</SPAN></SPAN>
AB123456C</SPAN></SPAN>
IQSBI</SPAN></SPAN>
1480.8712</SPAN></SPAN>
Smith</SPAN></SPAN>
AB123456C</SPAN></SPAN>
MGCBSA</SPAN></SPAN>
14939.885</SPAN></SPAN>
Smith</SPAN></SPAN>
AB123456C</SPAN></SPAN>
MGCBSA</SPAN></SPAN>
2195.5062</SPAN></SPAN>
Jones</SPAN></SPAN>
XW123456Z</SPAN></SPAN>
STAPGR</SPAN></SPAN>
488.1935</SPAN></SPAN>
Jones</SPAN></SPAN>
XW123456Z</SPAN></SPAN>
stapgr</SPAN></SPAN>
36.489</SPAN></SPAN>
Jones</SPAN></SPAN>
XW123456Z</SPAN></SPAN>
SZAAPA</SPAN></SPAN>
1860.91</SPAN></SPAN>
Jones</SPAN></SPAN>
XW123456Z</SPAN></SPAN>
SZAAPA</SPAN></SPAN>
139.09</SPAN></SPAN>
Jones</SPAN></SPAN>
XW123456Z</SPAN></SPAN>
SZGBA</SPAN></SPAN>
3721.82</SPAN></SPAN>
Jones</SPAN></SPAN>
XW123456Z</SPAN></SPAN>
SZGBA</SPAN></SPAN>
278.18</SPAN></SPAN>
Jones</SPAN></SPAN>
XW123456Z</SPAN></SPAN>
SZSUSA</SPAN></SPAN>
133.7666</SPAN></SPAN>
Jones</SPAN></SPAN>
XW123456Z</SPAN></SPAN>
szsusa</SPAN></SPAN>
9.9981</SPAN></SPAN>

<TBODY>
</TBODY>

There are a number of clients that have multiple investments that are shown by an alpha numeric code. I need to consolidate the number of units for each member in to one line. Ideally the output would look like this:</SPAN></SPAN>
SURNAME</SPAN></SPAN>
NINO</SPAN></SPAN>
CODE</SPAN></SPAN>
NO OF UNITS</SPAN></SPAN>
Smith</SPAN></SPAN>
AB123456C</SPAN></SPAN>
8AIA</SPAN></SPAN>
2278.4058</SPAN></SPAN>
Smith</SPAN></SPAN>
AB123456C</SPAN></SPAN>
HEEINC</SPAN></SPAN>
9744.9502</SPAN></SPAN>
Smith</SPAN></SPAN>
AB123456C</SPAN></SPAN>
IQSBI</SPAN></SPAN>
11480.6306</SPAN></SPAN>
Smith</SPAN></SPAN>
AB123456C</SPAN></SPAN>
MGCBSA</SPAN></SPAN>
17135.3912</SPAN></SPAN>
Jones</SPAN></SPAN>
XW123456Z</SPAN></SPAN>
STAPGR</SPAN></SPAN>
524.6825</SPAN></SPAN>
Jones</SPAN></SPAN>
XW123456Z</SPAN></SPAN>
SZAAPA</SPAN></SPAN>
2000</SPAN></SPAN>
Jones</SPAN></SPAN>
XW123456Z</SPAN></SPAN>
SZGBA</SPAN></SPAN>
4000</SPAN></SPAN>
Jones</SPAN></SPAN>
XW123456Z</SPAN></SPAN>
SZSUSA</SPAN></SPAN>
143.7647</SPAN></SPAN>

<TBODY>
</TBODY>

Any help would be greatly appreciated as I am new to this and very stumped!!!!</SPAN></SPAN>
Regards</SPAN></SPAN>
Michael</SPAN></SPAN>
 

Excel Facts

What is the shortcut key for Format Selection?
Ctrl+1 (the number one) will open the Format dialog for whatever is selected.
Hi there, to be honest any resolution is fine by me.I’m thinking that a macro would be best as the whole spreadsheet that I deal with is reasonably large.</SPAN>
 
Upvote 0
Ok... This code should get you started. It assumes that the Source data in in "Sheet1" and it will provide the results to "Sheet2". Both of these references can be changed to meet your needs.

It also assumes that the Source Data is sored by Column "A", "B" and "C".

Code:
Option Explicit
Sub Process()
    Dim WsSrc As Worksheet
    Dim WsDst As Worksheet
    Dim SrcRowNo As Long
    Dim DstRowNo As Long
    
    Dim CurrentKey As String
    Dim PreviousKey As String
    Dim RunningTotal As Double
    
    Set WsSrc = ThisWorkbook.Worksheets("Sheet1")
    Set WsDst = ThisWorkbook.Worksheets("Sheet2")
    
    PreviousKey = GetKey(WsSrc, 2)
    RunningTotal = Val(WsSrc.Cells(2, "D"))
    For SrcRowNo = 3 To WsSrc.Cells(WsSrc.Rows.Count, "A").End(xlUp).Row
        CurrentKey = GetKey(WsSrc, SrcRowNo)
        If CurrentKey = PreviousKey Then
            
            RunningTotal = RunningTotal + Val(WsSrc.Cells(SrcRowNo, "D"))
            'Debug.Print SrcRowNo, CurrentKey, RunningTotal, "Dup"
            
        Else
            Call WriteRec(WsDst, DstRowNo, CurrentKey, RunningTotal)
            
            PreviousKey = CurrentKey
            RunningTotal = Val(WsSrc.Cells(SrcRowNo, "D"))
        End If
    Next SrcRowNo
    Call WriteRec(WsDst, DstRowNo, CurrentKey, RunningTotal)
    MsgBox "Complete", vbInformation
End Sub
Function GetKey(WsSrc As Worksheet, SrcRowNo As Long)
    GetKey = (Trim(WsSrc.Cells(SrcRowNo, "A"))) & "~" & UCase(Trim(WsSrc.Cells(SrcRowNo, "B"))) & "~" & UCase(Trim(WsSrc.Cells(SrcRowNo, "C")))
End Function
Function WriteRec(Ws As Worksheet, DstRowNo As Long, ByVal Key As String, ByVal RunningTotal As Double)
    Dim I As Integer
    Dim vkey As Variant
    
    vkey = Split(Key, "~")
    DstRowNo = DstRowNo + 1
    
    For I = 0 To 2
        Ws.Cells(DstRowNo, I + 1) = vkey(I)
    Next I
    Ws.Cells(DstRowNo, I + 1) = RunningTotal
End Function
 
Upvote 0
Hi, i've put it in but when i run it idoes not like the following line:

Set WsDst = ThisWorkbook.Worksheets("Sheet2")

I get a Run-time error 9 Subscript out of range message.
 
Upvote 0
Cheers for stick with me, it's nearly there but i'm getting the same run-time error message on this line:

Ws.Cells(DstRowNo, I + 1) = vkey(I)
 
Upvote 0
That's very interesting... Was anything written to Sheet2 prior to getting the error?

In any event, Please replace the function "Write Rec" with this code

Code:
Function WriteRec(Ws As Worksheet, DstRowNo As Long, ByVal Key As String, ByVal RunningTotal As Double)
    Dim I As Integer
    Dim vkey As Variant
    
    vkey = Split(Key, "~")
    DstRowNo = DstRowNo + 1
    
    For I = 0 To UBound(vkey)
        Ws.Cells(DstRowNo, I + 1) = vkey(I)
    Next I
    Ws.Cells(DstRowNo, I + 1) = RunningTotal
End Function
 
Upvote 0
Just for interest, if any. Original data on sheet1 starting at A1, results on Sheet2, starting at A1, (so ensure no data on Sheet2 before running code)
Code:
Sub amalg_lines()
Dim d As Object, c() As Variant
Dim a As Variant
Dim n As Long, i As Long, j As Long
Dim s As String

Set d = CreateObject("scripting.dictionary")
d.comparemode = 1
a = Range("A1").CurrentRegion.Resize(, 4)
n = UBound(a, 1)
ReDim c(1 To n, 1 To 4)

For i = 1 To n
    s = a(i, 1) & Chr(30) & a(i, 3)
    If d(s) = Empty Then
        d(s) = d.Count
        For j = 1 To 4
            c(d(s), j) = a(i, j)
        Next j
    Else
        c(d(s), 4) = c(d(s), 4) + a(i, 4)
    End If
Next i

Sheets("Sheet2").Resize(d.Count, 4) = c

End Sub
 
Upvote 0

Forum statistics

Threads
1,213,543
Messages
6,114,243
Members
448,555
Latest member
RobertJones1986

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