Vba Code Required

[hrayani]

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]

 

[MickG]

Try this:-

NB:- It does not seem possible to use the "UNDO command when the value is subject to a formula !!!

Private [COLOR="Navy"]Sub[/COLOR] Worksheet_Calculate()
[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("T2", Range("T" & 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] Not IsError(Dn.Value) And Not IsError(Dn.Offset(, -1).Value) [COLOR="Navy"]Then[/COLOR]
     [COLOR="Navy"]If[/COLOR] Dn.Value > 0 And Dn.Offset(, -1) > 0 [COLOR="Navy"]Then[/COLOR]
      [COLOR="Navy"]If[/COLOR] Not .Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
        .Add Dn.Value, Val(Dn.Offset(, -1).Value)
      [COLOR="Navy"]Else[/COLOR]
        .Item(Dn.Value) = .Item(Dn.Value) + Val(Dn.Offset(, -1).Value)
      [COLOR="Navy"]End[/COLOR] If
     [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

 

[hrayani]

Thanks Mick.
I will try the code on Monday as I won’t be having access to my computer before that.
Will definitely update you.

 

[hrayani]

Hi Mick the code u provided is working fine in a seperate sheet where i am manually entering data lets say in column A/B and in column S/T have just simple formulas like =A2/=B2.

But when i tried the code in the desired sheet then its not working. Column S/T are picking values from cells which too have some Vlookup function.

at the bottom of the sheet it states: calculating 4 processors and the sheet just hangs up
after some time the following messge appears
Run-time-error '-2147417848 (80010108)':
Method'_Default of object "Range' failed

 

[MickG]

A bit out of my depth here !!
Try Googling "Excel + Calculating 4 Processors " with reference to Volatile functions and speeding up calculations.

 

[hrayani]

OK Mick

Thanks for your time.....

Can u suggest if we i simply use the concatenate formula ignoring cells which dont have either value or unit in Column S/T ?

 

[hrayani]

[TABLE="width: 383"]
<tbody>[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
Hello Mick, i found a solution with the concatenate Formula



here it is

=IF(AND(W2>0,W3>0,W4>0),CONCATENATE(TEXT(W2,"0,0")," ",V2," + ",TEXT(W3,"0,0")," ",V3," + ",TEXT(W4,"0,0")," ",V4),IF(AND(W2>0,W3>0),CONCATENATE(TEXT(W2,"0,0")," ",V2," + ",TEXT(W3,"0,0")," ",V3),IF(AND(W2>0,W4>0),CONCATENATE(TEXT(W2,"0,0")," ",V2," + ",TEXT(W4,"0,0")," ",V4),IF(AND(W3>0,W4>0),CONCATENATE(TEXT(W3,"0,0")," ",V3," + ",TEXT(W4,"0,0")," ",V4),IF(W2>0,CONCATENATE(TEXT(W2,"0,0")," ",V2),IF(W3>0,CONCATENATE(TEXT(W3,"0,0")," ",V3),IF(W4>0,CONCATENATE(TEXT(W4,"0,0")," ",V4),"")))))))

 

[MickG]

I'm please you now have a result.
Regrds Mick