Vba Code Required

hrayani

Well-known Member
Joined
Jul 23, 2010
Messages
1,516
Office Version
  1. 2016
Platform
  1. Windows
Hello,

I have data in cell S1:T7 (column S contains units and column T contains quantity)

Column Column
S T
Sets 123,456
Pcs 109,887
Pairs 123,001
Dozens 256,001
xxx 123,456
Sets 111,009

what i want in cell U1 is a total of each unit in the below format

234,465 Sets + 109,887 Pcs + 123,001 Pairs + 256,001 Dozens + 123,456 xxx

if there is no value in Column T against any unit then it should not be shown in the result cell.

is there a solution to it through a vba code ??? or an excel formula will also do

if anybody can provide a solution.

Regards,

Humayun



[TABLE="width: 166"]
<colgroup><col><col></colgroup><tbody>[TR]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
 

Excel Facts

Copy PDF to Excel
Select data in PDF. Paste to Microsoft Word. Copy from Word and paste to Excel.
Try this:-
Code:
[COLOR="Navy"]Sub[/COLOR] MG02Oct37
Private [COLOR="Navy"]Sub[/COLOR] CommandButton1_Click()
[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] Msg [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("S2"), Range("S" & Rows.Count).End(xlUp))
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] Dn.Offset(, 1) <> "" [COLOR="Navy"]Then[/COLOR]
    [COLOR="Navy"]If[/COLOR] Not .Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
        .Add Dn.Value, Dn.Offset(, 1).Value
    [COLOR="Navy"]Else[/COLOR]
        .Item(Dn.Value) = .Item(Dn.Value) + Dn.Offset(, 1).Value
    [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]

[COLOR="Navy"]Dim[/COLOR] K [COLOR="Navy"]As[/COLOR] Variant
 [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
    Msg = Msg & IIf(Msg = "", Format(.Item(K), "#,##0") & " " & K & " ", "+ " & Format(.Item(K), "#,##0") & " " & K & " ")
 [COLOR="Navy"]Next[/COLOR] K
Range("U1") = Msg
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Thanks MickG for the reply.

Code is not working ... its giving Compile error: Expected End Sub
 
Upvote 0
Sorry bad copying , remove line 2 in code, "Private Sub CommandButton1_Click()"
 
Last edited:
Upvote 0
MickG the code you provided is working but with the following isssues:

1) It should copy all the the cells having the same units and then should the total result. If the range has to or more values having the same unit (example: sets) then it should sum all the sets and show one total of sets. But its only working like a (concatenate formula)

2) I want the value to be shown first and then units (like 254 Sets + 109 Pcs + 214 Kgs)

Kindly also let me know that can we make it to run auto when the value(s) in the range changes so i don,t have to run the macro everytime.
An application change event like thing ???

and yes i am also ok with an excel formula - if there is any

Regards,
 
Last edited:
Upvote 0
Try this:-
Right click sheet tab, Select "View Code", VBwindow appears, paste code in VBWndow, Close VBWindow.
To run code , Change data in columns "S/T".
Code:
Private [COLOR="Navy"]Sub[/COLOR] Worksheet_Change(ByVal Target [COLOR="Navy"]As[/COLOR] Range)
[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] Msg [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
Application.EnableEvents = False
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("S2"), Range("S" & Rows.Count).End(xlUp))

[COLOR="Navy"]If[/COLOR] Not Intersect(Rng.Resize(, 2), Target) [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] Dn.Offset(, 1) > 0 [COLOR="Navy"]Then[/COLOR]
    [COLOR="Navy"]If[/COLOR] Not .Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
        .Add Dn.Value, Dn.Offset(, 1).Value
    [COLOR="Navy"]Else[/COLOR]
        .Item(Dn.Value) = .Item(Dn.Value) + Dn.Offset(, 1).Value
    [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]

[COLOR="Navy"]Dim[/COLOR] K [COLOR="Navy"]As[/COLOR] Variant
 [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
    Msg = Msg & IIf(Msg = "", Format(.Item(K), "#,##0") & " " & K & " ", "+ " & Format(.Item(K), "#,##0") & " " & K & " ")
 [COLOR="Navy"]Next[/COLOR] K
Range("U1") = Msg
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] If
Application.EnableEvents = True
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Thanks Mik

The values in Column S/T are result of formula.

1) What i have to do is press F2 key in the cell for the code to run when a change is made.

2) Just to check the code, I tried the code in a new worksheet and manually input the data. What i found is when the unit is deleted first
which is in Column S then the result does not change in cell U1. And i also found that even after deleting the value the result does not
change unless u press the F2 key in the above cells which contains data in Columns (S/T). The result in cell U1 only changes when u first delete the value (Column - T) and then the unit (Column - S) Even if u dont delete the unit then also the result changes (which is
correct).

3) Moreover, i also noticed that after deleting the value (Column - T) i am not able UNDO (CTR Z) it. Whereas, when the unit (Column - S) is deleted - i can UNDO it. Strange..............

What i require is the code should work on formula based results and which ever cell is deleted (unit or value) the result should not show it.
 
Last edited:
Upvote 0
You will need he "Calculate_Event"

Just to confirm:-
What i require is the code should work on formula based results and which ever cell is deleted (unit or value) the result should not show it.

1) If you add to columns "S" & "T" (By formula) the results will show/be Added in "U1", but if you Delete (by formula) the value in "S" or "T" the results in "U1" remain the same. Is that correct ???

2) What if you just reduce the value in "T".??
 
Last edited:
Upvote 0
1) The answer in cell U1 should ignore if either or both cells in Columns S/T are blank/deleted.

For Example:

If cell S5 = “Sets” & cell T5 = (0,blank,deleted)
or vice versa
If cell S5= (blank, deleted) & T5 = “290,876”

2) The answer in cell U1 should increase or decrease as soon as the value in Column T increases or decreases (provided there is some unit in the adjacent cell - as mentioned in point # 1)


Hey Mik, can you please switch the columns in the code ??
At this point Column S/T are Unit/Value respectively.
Can we make Column S for Value & T for Unit ??
 
Last edited:
Upvote 0
Q) If say "S5" = "Sets" and "T5" = "290,865" and part of the result in "U1" is "290,865 Sets", and then you remove Either "Sets" and/or "29.865" from "S5/T5". Should "U1" still show "290,865 Sets" or is it removed from "U1".
 
Upvote 0

Forum statistics

Threads
1,223,893
Messages
6,175,241
Members
452,622
Latest member
Laura_PinksBTHFT

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