I need to loop this section and overwrite the x marked positions with my variable x value but if i use it as it is shown on the pic nothings happen. If i enter any value like 1 or 2 instead of x it works. How can i use a variable instead of a value in these places?
Here is also the code:
For j = 1 To SumPositionen
If Sheets("Datenverarbeitung").Cells(Z, 4) = tempCommodityForm Then
session.findById("wnd[0]/usr/tabsTAB_DETAILS/tabpTAB_MF/ssubTABMF:/HERA/TRDMF10:2023/tbl/HERA/TRDMF10TC_2023/ctxt/HERA/TRDINOUT_S-MATNR[1,x]").Text = Sheets("Datenverarbeitung").Cells(a, 5) 'Eingabe Materialnummer in 1. Position
session.findById("wnd[0]/usr/tabsTAB_DETAILS/tabpTAB_MF/ssubTABMF:/HERA/TRDMF10:2023/tbl/HERA/TRDMF10TC_2023/txt/HERA/TRDINOUT_S-MFQUAN[2,x]").Text = Sheets("Datenverarbeitung").Cells(a, 6) 'Eingabe Menge in 1. Position
session.findById("wnd[0]/usr/tabsTAB_DETAILS/tabpTAB_MF/ssubTABMF:/HERA/TRDMF10:2023/tbl/HERA/TRDMF10TC_2023/ctxt/HERA/TRDINOUT_S-MFU[3,x]").Text = Sheets("Datenverarbeitung").Cells(a, 7) 'Eingabe UoM
x = x + 1
End If
a = a + 1
Next j
session.findById("wnd[0]/usr/tabsTAB_DETAILS/tabpTAB_MF/ssubTABMF:/HERA/" & _
"TRDMF10:2023/tbl/HERA/TRDMF10TC_2023/ctxt/HERA/TRDINOUT_S-MATNR[1,x]").Text
Here your string includes the literal value "x". What you really want is likely something more like:
session.findById("wnd[0]/usr/tabsTAB_DETAILS/tabpTAB_MF/ssubTABMF:/HERA/" & _
"TRDMF10:2023/tbl/HERA/TRDMF10TC_2023/ctxt/HERA/TRDINOUT_S-MATNR[1," & x & "]").Text
So something like:
Dim s As String, sht As Worksheet
'....
'....
Set sht = Sheets("Datenverarbeitung")
s = "wnd[0]/usr/tabsTAB_DETAILS/tabpTAB_MF/ssubTABMF:/HERA/" & _
"TRDMF10:2023/tbl/HERA/TRDMF10TC_2023/ctxt/HERA/"
For j = 1 To SumPositionen
If sht.Cells(Z, 4) = tempCommodityForm Then
session.findById(s & "TRDINOUT_S-MATNR[1," & x & "]").Text = sht.Cells(a, 5) 'Eingabe Materialnummer in 1. Position
session.findById(s & "TRDINOUT_S-MFQUAN[2," & x & "]").Text = sht.Cells(a, 6) 'Eingabe Menge in 1. Position
session.findById(s & "TRDINOUT_S-MFU[3," & x & "]").Text = sht.Cells(a, 7) 'Eingabe UoM
x = x + 1
End If
a = a + 1
Next j
define data type to variable link string and integer
Related
The following code has kicked around with me for many years. I do not know where I picked it up and for the most part it worked, when it worked. However, I have tried to use it on a new document. It worked once then didn't work again. I have tried to add the VB reference to Regular Expressions 5.5 but that was not correct. I was hoping for an easy fix.
The concept of the function was to display the content of a cell as an evaluated equation. It was to "show my work" so to speak so that in complex sheets, checking would be easier.
Unfortunately, the vbscript in the function is a black box to me.
Old Code
Option Explicit
Function SF(r As Range, Z As Integer) As String
Debug.Print r, Z
Const crep As String = "(([A-Za-z0-9_]+|'[^']+')!)?\$?[A-Z]{1,2}\$?[0-9]+"
Const mrep As String = "(([A-Za-z0-9_]+:[A-Za-z0-9_]+|'[^']+:[^']+')\!)|(\$?[A-Z]{1,2}\$?[0-9]+:\$?[A-Z]{1,2}\$?[0-9]+)"
Dim v As Variant, n As Long
Dim regex As Object, matches As Object, m As Object
SF = Mid(r.formula, 2)
Set regex = CreateObject("vbscript.regexp")
regex.Global = True
regex.Pattern = mrep
Set matches = regex.Execute(SF)
If matches.Count > 0 Then Exit Function
regex.Pattern = crep
Set matches = regex.Execute(SF)
n = matches.Count - 1
For n = n To 0 Step -1
Set m = matches.Item(n)
If InStr(m.Value, "!") = 0 Then v = Evaluate("'" & r.Parent.Name & "'!" & m.Value)
If IsNumeric(Val(v)) = True Then
v = Application.WorksheetFunction.Round(v, Z)
End If
SF = Left(SF, m.FirstIndex) & CStr(v) & _
Mid(SF, m.FirstIndex + m.Length + 1)
Next n
SF = "{ =" & SF & "}"
End Function
Updated Code-ish
Function SF(r As Range, Z As Integer) As String
Debug.Print r, Z
Const crep As String = "(([A-Za-z0-9_]+|'[^']+')!)?\$?[A-Z]{1,2}\$?[0-9]+"
Const mrep As String = "(([A-Za-z0-9_]+:[A-Za-z0-9_]+|'[^']+:[^']+')\!)|(\$?[A-Z]{1,2}\$?[0-9]+:\$?[A-Z]{1,2}\$?[0-9]+)"
Dim v As Variant, n As Long
SF = Mid(r.formula, 2)
n = InStr(SF, crep)
While n > 0
If InStr(Mid(SF, n), "!") = 0 Then
v = Evaluate("'" & r.Parent.Name & "'!" & Mid(SF, n, InStr(SF, crep) - n + Len(crep)))
If IsNumeric(Val(v)) = True Then
v = Application.WorksheetFunction.Round(v, Z)
End If
SF = Left(SF, n - 1) & CStr(v) & Mid(SF, n + Len(crep) + 1)
End If
n = InStr(SF, crep)
Wend
SF = "{ =" & SF & "}"
End Function
I can assume that this is not the first time this type of code has been written. Above is an attempt but the cell address is displayed and not the cell value. When referencing a named cell, it just shows the cell name.
Any thoughts? Am I going in the correct direction?
I want to extract postal code from address. I have tried isNumeric method below to extract 6 numeric from the address. Some of the address got 5 digit and some got 6 digit postal code.
But there is some error where sometimes 11900 only show 1900, 08000 shows 8000, and 4 digit number also show.
Range("A2").Select
i = 2
Do While ActiveCell <> ""
Address = UCase(Trim(Range("C" & CStr(i))) + " " + Trim(Range("D" & CStr(i))) + " " + Trim(Range("E" & CStr(i))) + " " + Trim(Range("F" & CStr(i))))
For p = 1 To Len(Address)
If IsNumeric(Mid(Address , p, 6)) Then
Range("O" & CStr(i)) = Mid(Address, p, 6)
End If
Next p
ActiveCell.Offset(1, 0).Select
i = i + 1
Loop
excel output
Address Postal Code
Wisma Pansar, 23-27 Jln Bengkel P.O. Box 319, 96007 Sibu Sarawak 96007
Wisma Lim , Lot 50A, Sec. 92A, 3.1/2 Sg Besi, 57100 Kuala Lumpur 57100
No. 265A, Jalan Sungai Petani 08300 Gurun Kedah Darul Aman 8300
No. 39, Jalan Nipah, Taman Lip Sin 11900 Sungai Nibong Pulau Pinang 1900
4-G, Lebuh Sungai Pinang 1 Sri Pinang 11600 Jelutong Pulau Pinang 11600
539/2, Gypsum Metropolitan Tower, Rajthevee Bangkok 10400, Thailand 0400,
LOTS 1869 &1938, 18th MILE KAJANG, SEMENYIH ROAD SELANGOR D.E. 1938, *no postal code in address
36a, Joo Chiat Place, Singapore 427760 0
I mean something like this:
Sub test()
Dim c As Range, p As Long, v, addr, i As Long, hit As Boolean
Set c = Range("A2") 'no need to select the cell
Do While c <> ""
addr = c.Value 'using your examples
hit = False
For p = 1 To Len(addr)
'will accept 5 or 6 digits - prefer 6
' so count down...
For i = 6 To 5 Step -1
v = Mid(addr, p, i)
If v Like String(i, "#") Then
c.Offset(0, 1).NumberFormat = "#" 'in case of leading zero
c.Offset(0, 1).Value = v
hit = True
Exit For
End If
Next i
If hit Then Exit For
Next p
Set c = c.Offset(1, 0)
Loop
End Sub
A regular expression approach would probably be much nicer.
To complement #TimWilliams his answer, hereby a solution making use of Array and Regular Expressions (with late binding). So let's immagine the following setup:
Now run the following code:
Sub Test()
Dim lr As Long, x As Long
Dim arr As Variant
Dim RegEx As Object: Set RegEx = CreateObject("vbscript.regexp")
'Set up regular expression
RegEx.Pattern = "\d{5,6}"
RegEx.Global = True
'Go through your data and execute RegEx
With Sheet1 'Change according to your sheets CodeName
lr = .Cells(.Rows.Count, 1).End(xlUp).Row
arr = .Range("A2:A" & lr).Value
.Range("B2:B" & lr).NumberFormat = "#"
For x = LBound(arr) To UBound(arr)
Set Matches = RegEx.Execute(arr(x, 1))
For Each Match In Matches
.Cells(x + 1, 2) = Match.Value
Next Match
Next x
End With
End Sub
Assuming the possibility of multiple matches within a string, the last match will be used.
If you are sure there can only be one match (or none), then you could also use:
If Matches.Count = 1 Then .Cells(x + 1, 2) = Matches.Item(0)
Instead of:
For Each Match In Matches
.Cells(x + 1, 2) = Match.Value
Next Match
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
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
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
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
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
This question already has answers here:
How do I put double quotes in a string in vba?
(5 answers)
Closed last year.
I cannot find the error(s) in this code. What I am trying to do is insert the formula in the column S, when "CN Equity" is used in the column A. I want the macro to run from row 6 to 69.
Sub fx()
Dim x As Long
x = 6
Do
If InStr(1, (Range("A" & x).Value), "CN Equity") > 0 Then
Sheets("Sheet1").Range("S" & x).Formula = "=BDP("CADUSD BGN Curncy","LAST_PRICE")" & x
End If
x = x + 1
Loop Until x = 70
End Sub
Consider:
Sub fx()
Dim x As Long
x = 6
Do
If InStr(1, (Range("A" & x).Value), "CN Equity") > 0 Then
Sheets("Sheet1").Range("S" & x).Formula = "=BDP(""CADUSD BGN Curncy"",""LAST_PRICE"")+" & x
End If
x = x + 1
Loop Until x = 70
End Sub
NOTE
Replace the + in the formula with * or & if necessary.
Just out of curiosity ,I am asking you a question which is as below:
Suppose i do have an array A1(6)=(45,25,,36,88),A2(6)=(14,25,11),A3(6)=(11,21,20,25,48).Now can we put those array values with the help of a single statement like single array assignment to a row,as here all the rows to a range of an Excel, Say here "C1:R3" range.
EDIT
If I need to assign them to a row like R1<- A1 + A2 +A3,R2<- A1 + A2 +A3. Can you tell me how to this?
R1<- (45,25,,36,88),14,25,11,,,,11,21,20,25,48,) same for R2.
Thanks,
Dim A(2,5)
For i = 0 to 5
A(0, i) = A1(i)
A(1, i) = A2(i)
A(2, i) = A3(i)
Next i
Range("C1:R3").Value = A
EDIT
For second part, to the best of my understanding:
Dim R(17)
For i = 0 To 2
For j = 0 To 5
R(6 * i + j) = A(i, j)
Next j
Next i
Range("C5:T5").Value = R
EDIT 2
Alternatively:
Dim R
R = Split(Join(A1, ",") & "," & Join(A2, ",") & "," & Join(A3, ","), ",")
Range("C5:T5").Value = R
You can use any delimiter you like (if it's appropriate for your data).