Re-arrange data set for mailing list

G

gato88

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

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

Required data structure (in view of a mailing list):
[TABLE="class: 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]Account 2[/TD]
[TD]Class 2[/TD]
[TD]Account 3[/TD]
[TD]Class 3[/TD]
[/TR]
[TR]
[TD]2000[/TD]
[TD]101[/TD]
[TD]JOE[/TD]
[TD]12345[/TD]
[TD]A[/TD]
[TD]34590[/TD]
[TD]A[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]2000[/TD]
[TD]312[/TD]
[TD]PETER[/TD]
[TD]23581[/TD]
[TD]A[/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]36711[/TD]
[TD]A[/TD]
[TD]15231[/TD]
[TD]A[/TD]
[/TR]
[TR]
[TD]2000[/TD]
[TD]789[/TD]
[TD]PAUL[/TD]
[TD]52315[/TD]
[TD]A[/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]
[/TR]
</tbody>[/TABLE]












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!
 

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.
Sort by date Sort by votes
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
 
Upvote 0
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)
 
Upvote 0
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
 
Upvote 0
MickG said:
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]
Click to expand...
 
Upvote 0
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
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Question Question
EXTRAPOLATE DATA FROM A TABLE!!!
Replies
6
Views
1K
JamesCanale
JamesCanale
T
  • Question Question
MATCH or VLOOKUP? or something different
Replies
3
Views
737
cerfani
C
B
  • Question Question
VBA Code to break list into separate emails worked on Friday - Broken today???
Replies
0
Views
749
bcurrey
B
X
  • Question Question
Compiling data from different worksheets based on a criteria
2
Replies
14
Views
1K
mumps
mumps
R
  • Question Question
VBA Mail a row to each person in a range
Replies
5
Views
1K
Macropod
Macropod

Forum statistics

Threads
1,223,236
Messages
6,170,915
Members
452,366
Latest member
TePunaBloke

Share this page

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