Extend vlookup to calculate cost of goods - excel

Question

I have sales report from e-shop and need to calculate cost of goods for each order line. Order line can look like one of these:
2x Lavazza Crema e Aroma 1kg - 1x Lavazza Dolce Caffe Crema 1kg
1x Lavazza Vending Aroma Top 1kg - 1x Arcaffe Roma 1Kg - 1x Kimbo - 100% Arabica Top Flavour
So, what I need Excel to do is to take each product, find its cost with vlookup function from another sheet and then multiply it with amount ordered. The issue is that nr of products ordered can vary from 1 to 10+.
I tried to calculate it with VBA, but the code is not working (I didn´t use multiplying at the moment, I know)
Maybe it is possible to solve this problem with excel formulas?
Function GoodsCost(str, Optional strDelim As String = " ")
larray = Split(str, strDelim)
Set lookup_range = Worksheets("Products").Range("B:E")
For i = LBound(larray) To UBound(larray)
skuarray = Split(larray(i), "x ")
skucost = Application.WorksheetFunction.VLookup(UBound(skuarray), lookup_range, 4, False)
cost = cost + skucost
Next i
GoodsCost = cost
End Function

Answer 1

Well, it seems like now the problem is solved. Of course, it works only if make an assumption that dashes(-) are not present in product descriptions. But it can be set up in product list. The other opportunity is to use another delimeter (for example "/"). We can use Ctrl+F to find all combinations like "x -" and replace them with "x /")
Function GoodsCost(str)
Dim answer As Double
Set Products = Worksheets("Products").Range("B:E")
larray = Split(str, " - ")
For i = LBound(larray) To UBound(larray)
sku = Split(larray(i), "x ")
Price = Application.WorksheetFunction.VLookup(sku(1), Products, 4, False) * sku(0)
answer = answer + Price
Next i
GoodsCost = answer
End Function

Answer 2

Below you find a UDF (User Defined Function) which you can use in your worksheet. After installing it in a standard code module (VBE names these like "Module1") you can call it from the worksheet like =CostOfGoods($A2) where A2 is the cell containing and order line as you have described.
Option Explicit
Function CostOfGoods(Cell As Range) As Single
' 15 Jan 2018
Const Delim As String = " - "
Dim Fun As Single ' function return value
Dim Sale As Variant
Dim Sp() As String
Dim i As Long
Dim PriceList As Range
Dim Qty As Single, Price As Single
Dim n As Integer
Sale = Trim(Cell.Value)
If Len(Sale) Then
Sp = Split(Sale, Delim)
Do While i <= UBound(Sp)
If InStr(Sp(i), "x ") = 0 Then
If Not ConcatSale(Sp, i, Delim) Then Exit Do
End If
i = i + 1
Loop
With Worksheets("Products")
i = .Cells(.Rows.Count, "B").End(xlUp).Row
' price list starts in row 2 (change as required)
Set PriceList = Range(.Cells(2, "B"), .Cells(i, "E"))
End With
For i = 0 To UBound(Sp)
Qty = Val(Sp(i))
n = InStr(Sp(i), " ")
Sp(i) = Trim(Mid(Sp(i), n))
On Error Resume Next
Price = Application.VLookup(Sp(i), PriceList, 4, False)
If Err Then
MsgBox "I couldn't find the price for" & vbCr & _
Sp(i) & "." & vbCr & _
"The total cost calculated excludes this item.", _
vbInformation, "Price not found"
Price = 0
End If
Fun = Fun + (Qty * Price)
Next i
End If
CostOfGoods = Fun
End Function
Private Function ConcatSale(Sale() As String, _
i As Long, _
Delim As String) As Boolean
' 15 Jan 2018
Dim Fun As Boolean ' function return value
Dim x As Long, f As Long
x = UBound(Sale)
If (i > 0) And (i <= x) Then
i = i - 1
Sale(i) = Sale(i) & Delim & Sale(i + 1)
For f = i + 1 To x - 1
Sale(f) = Sale(f + 1)
Next f
Fun = True
End If
If Fun Then ReDim Preserve Sale(x - 1)
ConcatSale = Fun
End Function

Answer 3

I have tested this and it works with dashes in product description:
Function GoodsCost(str, Optional strDelim As String = " ")
larray = Split(str, " ")
'split the cell contents by space
Set lookup_range = Worksheets("Products").Range("B:E")
'set lookup range
For i = LBound(larray) To UBound(larray) 'loop through array
nextproduct:
LPosition = InStr(larray(i), "x") 'find multiplier "x" in string
If LPosition = Len(larray(i)) Then 'if the last character is x
If Product <> "" Then GoTo lookitup 'lookup product
Quantity = larray(i) 'get quantity
Else
Product = Product & " " & larray(i) 'concatenate array until we get a full product description to lookup with
End If
Next i
lookitup:
If Right(Product, 2) = " -" Then Product = Left(Product, Len(Product) - 2)
If Left(Product, 1) = " " Then Product = Right(Product, Len(Product) - 1)
'above trim the Product description to remove unwanted spaces or dashes
cost = Application.WorksheetFunction.VLookup(Product, lookup_range, 4, False)
Quantity = Replace(Quantity, "x", "")
GoodsCost = cost * Quantity
MsgBox Product & " # Cost: " & GoodsCost
Product = ""
If i < UBound(larray) Then GoTo nextproduct
End Function

Answer 4

I'd use Regular Expressions to solve this. First it finds in the string were the 'delimiters' are by replacing the - with ; detecting only - that are next to a number followed by an x (i.e. a multiplier so ignoring - in product names). It then splits each of these results into a quantity and the product (again using RegEx). It then finds the product in your data and returns the cost of goods. If there is an error, or the product isn't in your data it returns a #Value error to show that there is an issue.
Public Function GoodsCost(str As String) As Double
Dim lookup_range As Range, ProductMatch As Range
Dim v, Match
Dim qty As Long
Dim prod As String
Dim tmp() As String
On Error GoTo err
Set lookup_range = Worksheets("Products").Range("B:E")
With CreateObject("vbscript.regexp")
.Global = True
.ignorecase = True
.pattern = "(\s\-\s)(?=[0-9]+x)"
If .test(str) Then
tmp = Split(.Replace(str, ";"), ";")
Else
ReDim tmp(0)
tmp(0) = str
End If
.pattern = "(?:([0-9]+)x\s(.+))"
For Each v In tmp
If .test(v) Then
Set Match = .Execute(v)
qty = Match.Item(0).submatches.Item(0)
prod = Trim(Match.Item(0).submatches.Item(1))
Set ProductMatch = lookup_range.Columns(1).Find(prod)
If Not ProductMatch Is Nothing Then
GoodsCost = GoodsCost + (qty * ProductMatch.Offset(0, 3))
Else
GoodsCost = CVErr(xlErrValue)
End If
End If
Next v
End With
Exit Function
err:
GoodsCost = CVErr(xlErrValue)
End Function