Concatenate cell value in asending order based on repeatation of another value

N

Negi1984

Board Regular
Joined
May 6, 2011
Messages
198
Hi All,

I have a data in range N5 : T till last cell, in below format

cellnametRXIDBSICHSNMAIOFreqListSaut
A123120 010172
A1232201119882
A12332011120002
B123141 0812
B123241181832
C12151 09821
D12120 01231
E12140 09751
F12130 0791

<tbody>
</tbody><colgroup><col><col><col><col><col><col><col></colgroup>

And want to arrange Column F in below format.
Logic :- if Cell name is repeat 1st time or only once in whole range than Freqlist will be same no as mentioned.
if cell name repeated 2nd time or more than freqlist cell value should combined all cell values in Freqlist in ascending order. Below is the sample output for the same.
cellnametRXIDBSICHSNMAIOFreqListSaut
A1231201017BBH
A123220110988 1017 2000BBH
A123320111988 1017 2000BBH
B123141812
B12324118081 832
C12151982
D12120123
E12140975
F1213079

<tbody>
</tbody><colgroup><col><col><col><col><col><col><col></colgroup>

Thanks in advance for your valuable suggestion.
 

Excel Facts

How to create a cell-sized chart?
Tiny charts, called Sparklines, were added to Excel 2010. Look for Sparklines on the Insert tab.
Sort by date Sort by votes
Try this, results start "F1" :-
NB:- I have assumed that your data Header start "N4" and actual data start "N5"
NB:- I don't know where the new data in column 7 comes from. ?????
Code: 
[COLOR="Navy"]Sub[/COLOR] MG22Jun19
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Q [COLOR="Navy"]As[/COLOR] Variant, Ray [COLOR="Navy"]As[/COLOR] Variant, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Dic [COLOR="Navy"]As[/COLOR] Object
Ray = Range("N4", Range("N" & Rows.Count).End(xlUp)).Resize(, 7)
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] n = 2 To UBound(Ray, 1)
  [COLOR="Navy"]If[/COLOR] Not Dic.Exists(Ray(n, 1)) [COLOR="Navy"]Then[/COLOR]
        ReDim nRay(1 To UBound(Ray, 1))
        nRay(1) = Ray(n, 6)
        Dic.Add Ray(n, 1), Array(n, nRay, 1)
    [COLOR="Navy"]Else[/COLOR]
        Q = Dic(Ray(n, 1))
            Q(2) = Q(2) + 1
            Q(1)(Q(2)) = Ray(n, 6)
            Q(0) = Q(0) & "," & n
        Dic(Ray(n, 1)) = Q
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Sp [COLOR="Navy"]As[/COLOR] Variant, Al [COLOR="Navy"]As[/COLOR] Variant, K [COLOR="Navy"]As[/COLOR] Variant, Rw [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] Dic.keys
    Sp = Split(Dic(K)(0), ",")
      [COLOR="Navy"]With[/COLOR] CreateObject("System.Collections.ArrayList")
          [COLOR="Navy"]For[/COLOR] n = 1 To UBound(Dic(K)(1))
                [COLOR="Navy"]If[/COLOR] Not IsEmpty(Dic(K)(1)(n)) [COLOR="Navy"]Then[/COLOR]
                .Add Dic(K)(1)(n)
                [COLOR="Navy"]End[/COLOR] If
            [COLOR="Navy"]Next[/COLOR]
        .Sort
      
        [COLOR="Navy"]For[/COLOR] Rw = 1 To UBound(Sp)
            Ray(Sp(Rw), 6) = Join(.ToArray, " ")
        [COLOR="Navy"]Next[/COLOR] Rw
    [COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]With[/COLOR] Range("F1").Resize(UBound(Ray, 1), UBound(Ray, 2))
        .Value = Ray
        .Columns.AutoFit
        .Borders.Weight = 2
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Hi Mick,

Thanks a lot for your valuable support. Code is working fine.
Regarding column 7 "Saut", I was applying formula manually, if Cell name are more than once repeated than change existing value to "BBH" other wise no change in this column.
 
Upvote 0
Hi Mick,

Need your support once again , there is slight changes in input data. Previously FreqList column having numerical data, but this time multiple numbers can be there as shown below. Could you please suggest , what changes is required to get the output.
Thank you once again for your valuable support.
Input Data,

cellname
tRXIDBSICHSNMAIOFreqListSaut
A123
120 010172
A123
2201111017 988 20002
A123
320111988 20002
B123
141 0822
B123
24118183,812
C12
151 09821
D12
120 01231
E12
140 09751
F12130 0791
<colgroup><col width="63" style="width: 47pt; mso-width-source: userset; mso-width-alt: 2304;"> <col width="46" style="width: 35pt; mso-width-source: userset; mso-width-alt: 1682;"> <col width="39" style="width: 29pt; mso-width-source: userset; mso-width-alt: 1426;"> <col width="35" style="width: 26pt; mso-width-source: userset; mso-width-alt: 1280;"> <col width="45" style="width: 34pt; mso-width-source: userset; mso-width-alt: 1645;"> <col width="106" style="width: 80pt; mso-width-source: userset; mso-width-alt: 3876;"> <col width="36" style="width: 27pt; mso-width-source: userset; mso-width-alt: 1316;"> <tbody> </tbody>

Output Data :

cellnametRXIDBSICHSNMAIOFreqListSaut
A123120 10172
A123220110988 1017 20002
A123320111988 1017 20002
B123141 822
B12324118081 82 832
C12151 9821
D12120 1231
E12140 9751
F12130 791
<colgroup><col width="63" style="width: 47pt; mso-width-source: userset; mso-width-alt: 2304;"> <col width="46" style="width: 35pt; mso-width-source: userset; mso-width-alt: 1682;"> <col width="39" style="width: 29pt; mso-width-source: userset; mso-width-alt: 1426;"> <col width="35" style="width: 26pt; mso-width-source: userset; mso-width-alt: 1280;"> <col width="45" style="width: 34pt; mso-width-source: userset; mso-width-alt: 1645;"> <col width="106" style="width: 80pt; mso-width-source: userset; mso-width-alt: 3876;"> <col width="36" style="width: 27pt; mso-width-source: userset; mso-width-alt: 1316;"> <tbody> </tbody>
 
Upvote 0
Try this for results starting "F1"
Code: 
[COLOR="Navy"]Sub[/COLOR] MG26Jul35
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Q [COLOR="Navy"]As[/COLOR] Variant, Ray [COLOR="Navy"]As[/COLOR] Variant, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Dic [COLOR="Navy"]As[/COLOR] Object, s [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Sp1 [COLOR="Navy"]As[/COLOR] Variant, nstr [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
Ray = Range("N4", Range("N" & Rows.Count).End(xlUp)).Resize(, 7)
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] n = 2 To UBound(Ray, 1)
  [COLOR="Navy"]If[/COLOR] Not Dic.Exists(Ray(n, 1)) [COLOR="Navy"]Then[/COLOR]
        ReDim nRay(1 To 10)
        nstr = ""
        Sp1 = Split(Ray(n, 6), " ")
        
        [COLOR="Navy"]For[/COLOR] s = 0 To UBound(Sp1)
            nRay(s + 1) = Sp1(s)
        nstr = nstr & IIf(nstr = "", Sp1(s), "," & Sp1(s))
        [COLOR="Navy"]Next[/COLOR] s
        Dic.Add Ray(n, 1), Array(n, nRay, 1, nstr)
    [COLOR="Navy"]Else[/COLOR]
        Q = Dic(Ray(n, 1))
            Sp1 = Split(Ray(n, 6), " ")
            [COLOR="Navy"]For[/COLOR] s = 0 To UBound(Sp1)
            
                [COLOR="Navy"]If[/COLOR] InStr(Q(3), Sp1(s)) = 0 [COLOR="Navy"]Then[/COLOR]
                     Q(3) = Q(3) & "," & Sp1(s)
                     Q(2) = Q(2) + 1
                     Q(1)(Q(2)) = Sp1(s)
                [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]Next[/COLOR] s
          
            
        Q(0) = Q(0) & "," & n
        Dic(Ray(n, 1)) = Q
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Sp [COLOR="Navy"]As[/COLOR] Variant, Al [COLOR="Navy"]As[/COLOR] Variant, K [COLOR="Navy"]As[/COLOR] Variant, Rw [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] Dic.keys
    Sp = Split(Dic(K)(0), ",")
      [COLOR="Navy"]With[/COLOR] CreateObject("System.Collections.ArrayList")
          [COLOR="Navy"]For[/COLOR] n = 1 To UBound(Dic(K)(1))
                [COLOR="Navy"]If[/COLOR] Not IsEmpty(Dic(K)(1)(n)) [COLOR="Navy"]Then[/COLOR]
                .Add Val(Dic(K)(1)(n))
                [COLOR="Navy"]End[/COLOR] If
            [COLOR="Navy"]Next[/COLOR]
        .Sort
        
        [COLOR="Navy"]For[/COLOR] Rw = 0 To UBound(Sp)
            [COLOR="Navy"]If[/COLOR] Rw = 0 [COLOR="Navy"]Then[/COLOR]
            Ray(Sp(Rw), 5) = ""
            [COLOR="Navy"]Else[/COLOR]
            Ray(Sp(Rw), 6) = Join(.ToArray, " ")
            Ray(Sp(Rw), 5) = Rw - 1
        [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]Next[/COLOR] Rw
    [COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]With[/COLOR] Range("F1").Resize(UBound(Ray, 1), UBound(Ray, 2))
        .Value = Ray
        .Columns.AutoFit
        .Borders.Weight = 2
[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

earthworm
  • Question
Split Data into separate worksheet based on Cell values
Replies
8
Views
449
earthworm
earthworm
K
  • Question
macro insert three columns repeatedly with all values based on multiple sheets
Replies
0
Views
316
KalilMe
K
airforceone
  • Solved
Yet Another Sheet Name Copying based on Cell Value Problem
2
Replies
17
Views
791
airforceone
airforceone
N
  • Question
Repeat & Concatenate Range Data with Fixed template lines
Replies
0
Views
389
Negi1984
N
J
  • Question
Formula to make cell equal a value based on another cell
Replies
1
Views
284
jondavis1987
J

Forum statistics

Threads
1,215,759
Messages
6,126,727
Members
449,332
Latest member
nokoloina

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