Re-arrange data set for mailing list

gato88

New Member
Joined
Feb 10, 2014
Messages
25
Hi appreciate if you could assist:

Current data set
Branch
Account Number
Customer NumberCustomer NameClass
200012345101JOEA
200034590101JOEA
200023581312PETERA
200032510511HARRYA
200036711511HARRYA
200015231511HARRYA
200052315789PAULA
etc...

<tbody>
</tbody>

Required data structure (in view of a mailing list):
BranchCustomer NumberCustomer NameAccount 1Class 1Account 2Class 2Account 3Class 3
2000101JOE12345A34590A
2000312PETER23581A
2000511HARRY32510A36711A15231A
2000789PAUL52315A
etc...

<tbody>
</tbody>












As the mailing list will grab the data under each header for each row (based on the customer number), I need to re-assign the data to the individual headers.
As per the sample above, the data will be sorted by customer number.
I have a long list of 500 customer numbers each with an average of 2 accounts, so I need to find an efficient solution to automate this task.

Appreciate your kind assistance. Thanks!
 

Some videos you may like

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.

MickG

MrExcel MVP
Joined
Jan 9, 2008
Messages
14,841
Try this for Results on sheet 2.
Code:
[COLOR="Navy"]Sub[/COLOR] MG17May57
[COLOR="Navy"]Dim[/COLOR] Ray [COLOR="Navy"]As[/COLOR] Variant, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Q [COLOR="Navy"]As[/COLOR] Variant, oMax [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Dic [COLOR="Navy"]As[/COLOR] Object
Ray = ActiveSheet.Range("A1").CurrentRegion.Resize(, 5)
ReDim nRay(1 To UBound(Ray, 1), 1 To 5)
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] n = 1 To UBound(Ray, 1)
    [COLOR="Navy"]If[/COLOR] Not Dic.Exists(Join(Application.Index(Ray, n, Array(1, 3, 4)))) [COLOR="Navy"]Then[/COLOR]
        c = c + 1
        nRay(c, 1) = Ray(n, 1)
        nRay(c, 2) = Ray(n, 3)
        nRay(c, 3) = Ray(n, 4)
        nRay(c, 4) = Ray(n, 2)
        nRay(c, 5) = Ray(n, 5)
        Dic.Add Join(Application.Index(Ray, n, Array(1, 3, 4))), Array(c, 5, 1)
[COLOR="Navy"]Else[/COLOR]
    Q = Dic.Item(Join(Application.Index(Ray, n, Array(1, 3, 4))))
         Q(1) = Q(1) + 2
         Q(2) = Q(2) + 1
         
         [COLOR="Navy"]If[/COLOR] UBound(nRay, 2) <= Q(1) [COLOR="Navy"]Then[/COLOR] ReDim Preserve nRay(1 To UBound(Ray, 1), 1 To Q(1))
         nRay(Q(0), Q(1) - 1) = Ray(n, 2)
         nRay(Q(0), Q(1)) = Ray(n, 5)
         nRay(1, Q(1) - 1) = "Account " & Q(2)
         nRay(1, Q(1)) = "Class" & Q(2)
         oMax = Application.Max(oMax, Q(1))
    Dic.Item(Join(Application.Index(Ray, n, Array(1, 3, 4)))) = Q
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] n
'[COLOR="Green"][B][/B][/COLOR]
[COLOR="Navy"]With[/COLOR] Sheets("Sheet2").Range("A1").Resize(c, oMax)
    .Value = nRay
    .Borders.Weight = 2
    .Columns.AutoFit
    .Sort _
    Key1:=.Parent.Range("B1"), Header:=xlYes
[COLOR="Navy"]End[/COLOR] With

[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 

gato88

New Member
Joined
Feb 10, 2014
Messages
25
AWSOME! Thanks Mick. Just what I was after.

Just one minor thing I found in the output sheet.
The first two dynamic column headers did not update in the output sheet, showing the original header names instead:
Account Number (instead of Account1) and Class (instead of Class1)
 

MickG

MrExcel MVP
Joined
Jan 9, 2008
Messages
14,841
Try this:-
Code:
[COLOR="Navy"]Sub[/COLOR] MG19May02
[COLOR="Navy"]Dim[/COLOR] Ray [COLOR="Navy"]As[/COLOR] Variant, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Q [COLOR="Navy"]As[/COLOR] Variant, oMax [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Dic [COLOR="Navy"]As[/COLOR] Object
Ray = ActiveSheet.Range("A1").CurrentRegion.Resize(, 5)
ReDim nRay(1 To UBound(Ray, 1), 1 To 5)
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] n = 1 To UBound(Ray, 1)
    [COLOR="Navy"]If[/COLOR] Not Dic.Exists(Join(Application.Index(Ray, n, Array(1, 3, 4)))) [COLOR="Navy"]Then[/COLOR]
        c = c + 1
         nRay(c, 1) = Ray(n, 1)
         nRay(c, 2) = Ray(n, 3)
         nRay(c, 3) = Ray(n, 4)
         nRay(c, 4) = Ray(n, 2)
         nRay(c, 5) = Ray(n, 5)
     [COLOR="Navy"]If[/COLOR] n = 1 [COLOR="Navy"]Then[/COLOR]
        nRay(c, 4) = "Account 1"
        nRay(c, 5) = "Class 1"
      [COLOR="Navy"]End[/COLOR] If
        Dic.Add Join(Application.Index(Ray, n, Array(1, 3, 4))), Array(c, 5, 1)
[COLOR="Navy"]Else[/COLOR]
    Q = Dic.Item(Join(Application.Index(Ray, n, Array(1, 3, 4))))
         Q(1) = Q(1) + 2
         Q(2) = Q(2) + 1
         
         [COLOR="Navy"]If[/COLOR] UBound(nRay, 2) <= Q(1) [COLOR="Navy"]Then[/COLOR] ReDim Preserve nRay(1 To UBound(Ray, 1), 1 To Q(1))
         nRay(Q(0), Q(1) - 1) = Ray(n, 2)
         nRay(Q(0), Q(1)) = Ray(n, 5)
         nRay(1, Q(1) - 1) = "Account " & Q(2)
         nRay(1, Q(1)) = "Class" & Q(2)
         oMax = Application.Max(oMax, Q(1))
    Dic.Item(Join(Application.Index(Ray, n, Array(1, 3, 4)))) = Q
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] n
'[COLOR="Green"][B][/B][/COLOR]
[COLOR="Navy"]With[/COLOR] Sheets("Sheet2").Range("A1").Resize(c, oMax)
    .Value = nRay
    .Borders.Weight = 2
    .Columns.AutoFit
    .Sort _
    Key1:=.Parent.Range("B1"), Header:=xlYes
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 

gato88

New Member
Joined
Feb 10, 2014
Messages
25
Try this:-

Code:
Regards Mick[/QUOTE]

Great! Thanks Mick. Fantastic job!
I need to add another field to the table, called "Rating" as per below.
This will create a new dynamic field in the output sheet using similar logic as what you created. 
Can you please assist? :confused:


[B]Current data set[/B]
[TABLE="class: cms_table_grid, width: 500"]
<tbody>[TR]
[TD]Branch[/TD]
[TD]Account Number[/TD]
[TD]Customer Number[/TD]
[TD]Customer Name[/TD]
[TD]Class[/TD]
[TD]Rating[/TD]
[/TR]
[TR]
[TD]2000[/TD]
[TD]12345[/TD]
[TD]101[/TD]
[TD]JOE[/TD]
[TD]A[/TD]
[TD]10[/TD]
[/TR]
[TR]
[TD]2000[/TD]
[TD]34590[/TD]
[TD]101[/TD]
[TD]JOE[/TD]
[TD]A[/TD]
[TD]11[/TD]
[/TR]
[TR]
[TD]2000[/TD]
[TD]23581[/TD]
[TD]312[/TD]
[TD]PETER[/TD]
[TD]A[/TD]
[TD]12[/TD]
[/TR]
[TR]
[TD]2000[/TD]
[TD]32510[/TD]
[TD]511[/TD]
[TD]HARRY[/TD]
[TD]A[/TD]
[TD]15[/TD]
[/TR]
[TR]
[TD]2000[/TD]
[TD]36711[/TD]
[TD]511[/TD]
[TD]HARRY[/TD]
[TD]A[/TD]
[TD]23[/TD]
[/TR]
[TR]
[TD]2000[/TD]
[TD]15231[/TD]
[TD]511[/TD]
[TD]HARRY[/TD]
[TD]A[/TD]
[TD]31[/TD]
[/TR]
[TR]
[TD]2000[/TD]
[TD]52315[/TD]
[TD]789[/TD]
[TD]PAUL[/TD]
[TD]A[/TD]
[TD]34[/TD]
[/TR]
[TR]
[TD]etc...[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

 
[B]Required data structure (in view of a mailing list):[/B]
[TABLE="class: cms_table_grid, width: 500, align: left"]
<tbody>[TR]
[TD]Branch[/TD]
[TD]Customer Number[/TD]
[TD]Customer Name[/TD]
[TD]Account 1[/TD]
[TD]Class 1[/TD]
[TD]Rating 1[/TD]
[TD]Account 2[/TD]
[TD]Class 2[/TD]
[TD]Rating 2[/TD]
[TD]Account 3[/TD]
[TD]Class 3[/TD]
[TD]Rating
3[/TD]
[/TR]
[TR]
[TD]2000[/TD]
[TD]101[/TD]
[TD]JOE[/TD]
[TD]12345[/TD]
[TD]A[/TD]
[TD]10[/TD]
[TD]34590[/TD]
[TD]A[/TD]
[TD]11[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]2000[/TD]
[TD]312[/TD]
[TD]PETER[/TD]
[TD]23581[/TD]
[TD]A[/TD]
[TD]12[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]2000[/TD]
[TD]511[/TD]
[TD]HARRY[/TD]
[TD]32510[/TD]
[TD]A[/TD]
[TD]15[/TD]
[TD]36711[/TD]
[TD]A[/TD]
[TD]23[/TD]
[TD]15231[/TD]
[TD]A[/TD]
[TD]31[/TD]
[/TR]
[TR]
[TD]2000[/TD]
[TD]789[/TD]
[TD]PAUL[/TD]
[TD]52315[/TD]
[TD]A[/TD]
[TD]34[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]etc...[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
 

MickG

MrExcel MVP
Joined
Jan 9, 2008
Messages
14,841
Try this for results on sheet2
Code:
[COLOR="Navy"]Sub[/COLOR] MG21May49
[COLOR="Navy"]Dim[/COLOR] Ray [COLOR="Navy"]As[/COLOR] Variant, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Q [COLOR="Navy"]As[/COLOR] Variant, oMax [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Dic [COLOR="Navy"]As[/COLOR] Object
Ray = ActiveSheet.Range("A1").CurrentRegion.Resize(, 6)
ReDim nRay(1 To UBound(Ray, 1), 1 To 6)
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] n = 1 To UBound(Ray, 1)
    [COLOR="Navy"]If[/COLOR] Not Dic.Exists(Join(Application.Index(Ray, n, Array(1, 3, 4)))) [COLOR="Navy"]Then[/COLOR]
        c = c + 1
         nRay(c, 1) = Ray(n, 1)
         nRay(c, 2) = Ray(n, 3)
         nRay(c, 3) = Ray(n, 4)
         nRay(c, 4) = Ray(n, 2)
         nRay(c, 5) = Ray(n, 5)
         nRay(c, 6) = Ray(n, 6)
     [COLOR="Navy"]If[/COLOR] n = 1 [COLOR="Navy"]Then[/COLOR]
        nRay(c, 4) = "Account 1"
        nRay(c, 5) = "Class 1"
        nRay(c, 6) = "Rating 1"
      [COLOR="Navy"]End[/COLOR] If
        Dic.Add Join(Application.Index(Ray, n, Array(1, 3, 4))), Array(c, 6, 1)
[COLOR="Navy"]Else[/COLOR]
    Q = Dic.Item(Join(Application.Index(Ray, n, Array(1, 3, 4))))
         Q(1) = Q(1) + 3
         Q(2) = Q(2) + 1
         
         [COLOR="Navy"]If[/COLOR] UBound(nRay, 2) <= Q(1) [COLOR="Navy"]Then[/COLOR] ReDim Preserve nRay(1 To UBound(Ray, 1), 1 To Q(1))
         nRay(Q(0), Q(1) - 2) = Ray(n, 2)
         nRay(Q(0), Q(1) - 1) = Ray(n, 5)
         nRay(Q(0), Q(1)) = Ray(n, 6)
         nRay(1, Q(1) - 2) = "Account " & Q(2)
         nRay(1, Q(1) - 1) = "Class" & Q(2)
         nRay(1, Q(1)) = "Rating" & Q(2)
         oMax = Application.Max(oMax, Q(1))
    Dic.Item(Join(Application.Index(Ray, n, Array(1, 3, 4)))) = Q
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] n
'[COLOR="Green"][B][/B][/COLOR]
[COLOR="Navy"]With[/COLOR] Sheets("Sheet2").Range("A1").Resize(c, oMax)
    .Value = nRay
    .Borders.Weight = 2
    .Columns.AutoFit
    .Sort _
    Key1:=.Parent.Range("B1"), Header:=xlYes
[COLOR="Navy"]End[/COLOR] With


[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 

Watch MrExcel Video

Forum statistics

Threads
1,099,492
Messages
5,468,927
Members
406,620
Latest member
Gitani123

This Week's Hot Topics

Top