PDA

View Full Version : Not sure if possible..brackets issue



Immatoity
06-30-2010, 04:10 AM
I have a worksheet with lots of rows of data in...

column J contains cells that have data as follows,,not always seperated by the underscore
U25593(10)_U25592(16)_H3893(3)_U25504(13)

I need to "add" up the amounts in brackets e.g the one above totals 42 (the 10+16+3+13).

Can I do this in VBA rather than trawling manually through literally a thousand rows?

The other bit, that is a "desirable" rather than essential is to give a % - ie H3893 = 3/42 (in %) format?

Bob Phillips
06-30-2010, 05:37 AM
Is that data all in one cell or in one value in each cell?

Tommy
06-30-2010, 05:38 AM
Hi Immatoity,

I am not sure how you want it placed but this works per your request.


Option Explicit
Sub AddPara(iInfo As String, iRow As Long, iCol As Long)
Dim mData() As String, mTotal As Double, Percent As Double
Dim mI As Long
mData = Split(iInfo, "(")
For mI = LBound(mData, 1) + 1 To UBound(mData, 1)
mTotal = mTotal + Val(mData(mI))
Next
ActiveSheet.Cells(iRow, iCol + 1 + mI).Value = mTotal
For mI = LBound(mData, 1) + 1 To UBound(mData, 1)
Percent = Val(mData(mI)) / mTotal
ActiveSheet.Cells(iRow, iCol + 8 + mI).Value = Percent
Next
End Sub
Sub Test()
AddPara ActiveCell.Text, ActiveCell.Row, ActiveCell.Column
End Sub

Immatoity
06-30-2010, 05:58 AM
many thanks I will give it a try later on:)





I am not sure how you want it placed but this works per your request.


Option Explicit
Sub AddPara(iInfo As String, iRow As Long, iCol As Long)
Dim mData() As String, mTotal As Double, Percent As Double
Dim mI As Long
mData = Split(iInfo, "(")
For mI = LBound(mData, 1) + 1 To UBound(mData, 1)
mTotal = mTotal + Val(mData(mI))
Next
ActiveSheet.Cells(iRow, iCol + 1 + mI).Value = mTotal
For mI = LBound(mData, 1) + 1 To UBound(mData, 1)
Percent = Val(mData(mI)) / mTotal
ActiveSheet.Cells(iRow, iCol + 8 + mI).Value = Percent
Next
End Sub
Sub Test()
AddPara ActiveCell.Text, ActiveCell.Row, ActiveCell.Column
End Sub

Immatoity
07-01-2010, 04:37 AM
Hi..not sure I am doing this right...

I want the results in column S please.

When I try at present.. I use Alt+F11..copy the VBA , save and close VB window..

then click tools macro, run, and the macro is called "test"..

when I run it.. it gives me a 0?

Tinbendr
07-01-2010, 04:50 AM
The cursor has to be in the cell containing the data, hence...

AddPara ActiveCell.Text, ActiveCell.Row, ActiveCell.Column

Immatoity
07-01-2010, 05:00 AM
The cursor has to be in the cell containing the data, hence...

AddPara ActiveCell.Text, ActiveCell.Row, ActiveCell.Column

My bad...

I need the data in J to stay the same and the result of the macro to be in column S, and copied down to end row ta

Tommy
07-01-2010, 05:06 AM
:)

Tommy
07-01-2010, 05:16 AM
I hard coded the locations.


Option Explicit
Sub AddPara(iInfo As String, iRow As Long, iCol As Long)
Dim mData() As String, mTotal As Double, Percent As Double
Dim mI As Long
mData = Split(iInfo, "(")
For mI = LBound(mData, 1) + 1 To UBound(mData, 1)
mTotal = mTotal + Val(mData(mI))
Next
ActiveSheet.Cells(iRow, 19).Value = mTotal
For mI = LBound(mData, 1) + 1 To UBound(mData, 1)
Percent = Val(mData(mI)) / mTotal
ActiveSheet.Cells(iRow, 19 + mI).Value = Percent
Next
End Sub
Sub Test()
Dim mI As Long, mN As Long
mI = ActiveSheet.UsedRange.Rows.Count
For mN = 1 To mI
AddPara ActiveSheet.Cells(mN, 10), mN, 10
Next
End Sub

Immatoity
07-01-2010, 06:31 AM
i have attached a few sample rows from the file I am working on..

as I say column J is the one I need to extract the data from..

Tinbendr
07-01-2010, 07:12 AM
Using Tommy's great code, this is my version.

I also changed the
Dim Percent as Double to
Dim Percent as Variant So that the Format function could display a visual output.

Tommy
07-01-2010, 08:18 AM
Now that I have a worksheet to work with.....

I am posting the code also just because it is taking about 3 minutes between clicking the submit till something happens.


Option Explicit
Sub AddPara(iInfo As String, iRow As Long, iCol As Long)
Dim mData() As String, mTotal As Double, Percent As String
Dim mI As Long
mData = Split(iInfo, "(")
If UBound(mData) > 0 Then
For mI = LBound(mData, 1) + 1 To UBound(mData, 1)
mTotal = mTotal + Val(mData(mI))
Next
ActiveSheet.Cells(iRow, 19).Value = mTotal
For mI = LBound(mData, 1) + 1 To UBound(mData, 1)
Percent = Percent & "|" & Format(Val(mData(mI)) / mTotal, "0.00%")
Next
ActiveSheet.Cells(iRow, 20).Value = Mid(Percent, 2)
End If
End Sub
Sub Test()
Dim mI As Long, mN As Long
mI = ActiveSheet.UsedRange.Rows.Count
For mN = 1 To mI
If ActiveSheet.Cells(mN, 10).Value > "" Then
AddPara ActiveSheet.Cells(mN, 10), mN, 10
End If
Next
End Sub

Immatoity
07-08-2010, 05:51 AM
thanks..sorry for delay.. I will try this later on this evening..many thanks again

Immatoity
07-13-2010, 02:44 AM
ok have had a chance to review this now... it's nearly there but still one small issue..

Using Glass example C.xls - row 7 - the result in column T is 33.33%_66.67% ( which is correct). However I only need the % for the item in column L..which in this case is H003804 = 66.67%, i don't want/need the 33.33% (which relates to U24842 in cell J7)

I hope this makes sense.. not sure if its possible or not?

EDIT : being thick here.. I have clicked Alt+F11, copied the code above, saved and closed VBA.

When I click tools macros run "Sheet4.CalcColJ" nothing happens? Also no "sub" Para seems to appear?

Tommy
07-13-2010, 06:05 PM
Run the test macro :) This should do the same thing except that the first item is not added to the string.

Option Explicit
Sub AddPara(iInfo As String, iRow As Long, iCol As Long)
Dim mData() As String, mTotal As Double, Percent As String
Dim mI As Long
mData = Split(iInfo, "(")
If UBound(mData) > 0 Then
For mI = LBound(mData, 1) + 2 To UBound(mData, 1)
mTotal = mTotal + Val(mData(mI))
Next
ActiveSheet.Cells(iRow, 19).Value = mTotal
For mI = LBound(mData, 1) + 2 To UBound(mData, 1)
Percent = Percent & "|" & Format(Val(mData(mI)) / mTotal, "0.00%")
Next
ActiveSheet.Cells(iRow, 20).Value = Mid(Percent, 2)
End If
End Sub
Sub Test()
Dim mI As Long, mN As Long
mI = ActiveSheet.UsedRange.Rows.Count
For mN = 1 To mI
If ActiveSheet.Cells(mN, 10).Value > "" Then
AddPara ActiveSheet.Cells(mN, 10), mN, 10
End If
Next
End Sub

Immatoity
07-15-2010, 01:18 AM
Ok.. I am attaching the file (top 100 rows) after I have ran the macro..

What I did was

a) Opened the file
b) Clicked Alt+F11
c) on the worksheet I am working on I pasted the code from Tommy above
d) I saved it in VBA window, then closed VBA window to return to excel
e) I ran "test" - it gave me the results you can see , and came up with an "overflow" error, so it only went down to row 82, it didn't go any further
f) you can see the results of the code in cols S&T

I bet it's me doing something stupid!

Tinbendr
07-15-2010, 02:44 AM
At row 83-85 there is an extra '(' at the end of the data. That's causing the overflow.

You could add this after the Dim in the AddPara sub
Dim mI As Long
If Right(iInfo, 1) = "(" Then
iInfo = Left(iInfo, Len(iInfo) - 1)
End If
This strips the extra bracket off. However if the data has extraneous data like this from time to time, you may have to add more error checking.