Combine line items

[kdf685]

I have a worksheet that is similar as follows


[TABLE="width: 500"]
<tbody>[TR]
[TD]ItemNum[/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[/TR]
[TR]
[TD]A[/TD]
[TD][/TD]
[TD]50[/TD]
[TD]50[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]A[/TD]
[TD]50[/TD]
[TD][/TD]
[TD][/TD]
[TD]50[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]A[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]50[/TD]
[/TR]
[TR]
[TD]B[/TD]
[TD]40[/TD]
[TD][/TD]
[TD]40[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]B[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]40[/TD]
[/TR]
[TR]
[TD]B[/TD]
[TD][/TD]
[TD]30[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

How can I combine the items that are the same all on line?

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG22May26
[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] ac [COLOR="Navy"]As[/COLOR] Range, nRng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Set[/COLOR] Rng = ActiveSheet.Cells(1).CurrentRegion
Application.ScreenUpdating = False
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng.Columns(1).Cells
     [COLOR="Navy"]If[/COLOR] Dn.Row > 1 [COLOR="Navy"]Then[/COLOR]
         [COLOR="Navy"]If[/COLOR] Not .Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
                .Add Dn.Value, Dn
         [COLOR="Navy"]Else[/COLOR]
                [COLOR="Navy"]If[/COLOR] nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR] [COLOR="Navy"]Set[/COLOR] nRng = Dn Else [COLOR="Navy"]Set[/COLOR] nRng = Union(nRng, Dn)
         [COLOR="Navy"]End[/COLOR] If
      
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] ac [COLOR="Navy"]In[/COLOR] Rng.Rows(Dn.Row).Cells
            [COLOR="Navy"]If[/COLOR] Not ac.Column = 1 [COLOR="Navy"]Then[/COLOR]
                [COLOR="Navy"]If[/COLOR] Not IsEmpty(ac) [COLOR="Navy"]Then[/COLOR]
                    Cells(.Item(Dn.Value).Row, ac.Column) = ac
                [COLOR="Navy"]End[/COLOR] If
            [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]Next[/COLOR] ac
    [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]If[/COLOR] Not nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR] nRng.EntireRow.Delete
Application.ScreenUpdating = True
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[kdf685]

Is this VBA? I dont know where this would go.

 

[MickG]

This code will Gather each set of ItemNum" data in one line and delete the unwanted rows as shown below:-
[TABLE="width: 299"]
<colgroup><col width="78" style="width: 59pt; mso-width-source: userset; mso-width-alt: 2787;"> <col width="64" style="width: 48pt;" span="5"> <tbody>[TR]
[TD="class: xl65, width: 78, bgcolor: white"]ItemNum[/TD]
[TD="class: xl65, width: 64, bgcolor: white"]A[/TD]
[TD="class: xl65, width: 64, bgcolor: white"]B[/TD]
[TD="class: xl65, width: 64, bgcolor: white"]C[/TD]
[TD="class: xl65, width: 64, bgcolor: white"]D[/TD]
[TD="class: xl65, width: 64, bgcolor: white"]E[/TD]
[/TR]
[TR]
[TD="class: xl65, width: 78, bgcolor: white"]A[/TD]
[TD="class: xl65, width: 64, bgcolor: white"]50[/TD]
[TD="class: xl65, width: 64, bgcolor: white"]50[/TD]
[TD="class: xl65, width: 64, bgcolor: white"]50[/TD]
[TD="class: xl65, width: 64, bgcolor: white"]50[/TD]
[TD="class: xl65, width: 64, bgcolor: white"]50[/TD]
[/TR]
[TR]
[TD="class: xl65, width: 78, bgcolor: white"]B[/TD]
[TD="class: xl65, width: 64, bgcolor: white"]40[/TD]
[TD="class: xl65, width: 64, bgcolor: white"]30[/TD]
[TD="class: xl65, width: 64, bgcolor: white"]40[/TD]
[TD="class: xl65, width: 64, bgcolor: white"] [/TD]
[TD="class: xl65, width: 64, bgcolor: white"]40[/TD]
[/TR]
</tbody>[/TABLE]



To Save and Run Code:-
Copy code from Thread
In Your Data sheet , Click "Alt+F11",:- Vb Window appears.
From the VBWindow toolbar, Click "Insert" ,"Module":- New VBwindow appears .
Paste Code into this window.
Close Vbwindow.
On sheet Click "Developer tab", Click "Macro". Macro dialog box appears.
Select Macro (with same name) from List.
On the right of Dialog box Click "Run"
The Sheet should now be updated.
Regrds Mick