Lookup Multiple Values In A Single Cell (separated By Commas) And Then Return The Sum of the Corresponding Values

mkary

New Member
Joined
Feb 6, 2013
Messages
2
So here is what my challenge is...

I have a list of equipment I use. I have the list created in a table from which i can select multiple values and it will place them into the same cell and separate them by commas (like seen below in column A). To do this I am using the following code:
"Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
'run code if only one cell was changed
If Target.Count > 1 Then GoTo exitHandler

Select Case Target.Column
Case 2 'this Case line works for column B only
'Case 2, 5, 6 'this Case line works for multiple columns
On Error Resume Next
'check the cell for data validation
Set rngDV = Target.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitHandler
If rngDV Is Nothing Then GoTo exitHandler

If Intersect(Target, rngDV) Is Nothing Then
'do nothing
Else
Application.EnableEvents = False
newVal = Target.Value
Application.Undo
oldVal = Target.Value
Target.Value = newVal
If oldVal <> "" Then
If newVal <> "" Then
Target.Value = oldVal _
& ", " & newVal
End If
End If
End If
End Select
exitHandler:
Application.EnableEvents = True
End Sub"

Now what I want to happen when I select the items in Column A is for Column B (Cost) to sum the associated values from the adjacent table (Equipment/Price). Essentially what I want to get out of it is =sum(5.09+50.45+20.00+20.00) but without having to manually input as my actual list has ~100+ Items. Is this possible?

EquipmentCostEquipmentPrice
Item 1, Item 3, Item 5, Item 5ExampleItem 15.09
Item 2, Item 3Item 24.99
Item 2, Item 3, Item 4, Item 5Item 350.45
Item 1, Item 4, Item 5Item 416.95
Item 520.00

<tbody>
</tbody>
 

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)
assumimg your price data starts in E2 to Fn, try the following user defined function, I have been working on something similar at work, so this is a trimmed down version

Code:
Function ItemSum(myrange As Range)

Dim MyDelim As String

Dim LastPriceRow As Integer
Dim NumPrice As Integer

'
'****
' set delimiter
'****
'

MyDelim = ","

'
'****
' Load our prices, this creates a 2 dimensional array starting at 1
'****
'
Dim CurSheet As String
CurSheet = ActiveSheet.Name

LastPriceRow = Worksheets(CurSheet).Range("E" & Rows.Count).End(xlUp).Row
PriceLookup = Worksheets(CurSheet).Range("E2:F" & LastPriceRow)
NumPrice = UBound(PriceLookup)
MyPas = Split(myrange.Value, MyDelim)
mysum = 0
For p = 0 To UBound(MyPas)
    mysum = mysum + GetPrice(MyPas(p), PriceLookup)
Next p
ItemSum = mysum
End Function
Function GetPrice(PriceCode, PriceLookup) As String
NumPrice = UBound(PriceLookup)
LowPrice = LBound(PriceLookup)
PriceCode = LTrim(RTrim(PriceCode))
For g = LowPrice To NumPrice
    If PriceCode = PriceLookup(g, 1) Then
        GetPrice = PriceLookup(g, 2)
        Exit Function
    End If
Next g
End Function

in cell B2 put =itemsum(A2)
 
Upvote 0
assumimg your price data starts in E2 to Fn, try the following user defined function, I have been working on something similar at work, so this is a trimmed down version

Code:
Function ItemSum(myrange As Range)

Dim MyDelim As String

Dim LastPriceRow As Integer
Dim NumPrice As Integer

'
'****
' set delimiter
'****
'

MyDelim = ","

'
'****
' Load our prices, this creates a 2 dimensional array starting at 1
'****
'
Dim CurSheet As String
CurSheet = ActiveSheet.Name

LastPriceRow = Worksheets(CurSheet).Range("E" & Rows.Count).End(xlUp).Row
PriceLookup = Worksheets(CurSheet).Range("E2:F" & LastPriceRow)
NumPrice = UBound(PriceLookup)
MyPas = Split(myrange.Value, MyDelim)
mysum = 0
For p = 0 To UBound(MyPas)
    mysum = mysum + GetPrice(MyPas(p), PriceLookup)
Next p
ItemSum = mysum
End Function
Function GetPrice(PriceCode, PriceLookup) As String
NumPrice = UBound(PriceLookup)
LowPrice = LBound(PriceLookup)
PriceCode = LTrim(RTrim(PriceCode))
For g = LowPrice To NumPrice
    If PriceCode = PriceLookup(g, 1) Then
        GetPrice = PriceLookup(g, 2)
        Exit Function
    End If
Next g
End Function

in cell B2 put =itemsum(A2)

Thanks for the quick response jimrward! Unfortunately I am having trouble getting it to work... I get a #NAME? error when I put =itemsum(A2) in cell B2. This may just be me being a bit slow as I am not particularily well versed in the coding and functions of excel but am very keen to learn it! Any further advise you could provide would be greatly appreciated!

Cheers,
Mike
 
Upvote 0

Forum statistics

Threads
1,216,109
Messages
6,128,884
Members
449,477
Latest member
panjongshing

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