Printable View
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?
Is that data all in one cell or in one value in each cell?
Hi Immatoity,
I am not sure how you want it placed but this works per your request.
[VBA]
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
[/VBA]
many thanks I will give it a try later on:)
Quote:
Originally Posted by Tommy
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?
The cursor has to be in the cell containing the data, hence...
AddPara ActiveCell.Text, ActiveCell.Row, ActiveCell.Column
My bad...Quote:
Originally Posted by Tinbendr
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
:)
I hard coded the locations.
[VBA]
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
[/VBA]
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..
Using Tommy's great code, this is my version.
I also changed the
[vba]Dim Percent as Double[/vba] to
[vba]Dim Percent as Variant[/vba] So that the Format function could display a visual output.
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.
[VBA]
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
[/VBA]
thanks..sorry for delay.. I will try this later on this evening..many thanks again
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?
Run the test macro :) This should do the same thing except that the first item is not added to the string.
[VBA]
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
[/VBA]
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!
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
[vba]Dim mI As Long
If Right(iInfo, 1) = "(" Then
iInfo = Left(iInfo, Len(iInfo) - 1)
End If
[/vba]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.