i need some help here, i have a command for script sap(vba) where i just need to change a number am each line, is there a way to have just one line and create a loop? num1 = 5, num2 = 9, num3 = 10
session.findById("wnd[1]/usr/chk[2,5]").Selected = True
session.findById("wnd[1]/usr/chk[2,9]").Selected = True
session.findById("wnd[1]/usr/chk[2,10]").Selected = True
what i hope
session.findById("wnd[1]/usr/chk[2,numX]").Selected = True
Another way using a For Each loop.
Sub Test()
Dim vNums() As Variant
vNums = Array(5, 9, 10)
Dim vNum As Variant
For Each vNum In vNums
session.findById("wnd[1]/usr/chk[2," & vNum & "]").Selected = True
Next vNum
End Sub
for example:
For numx = 5 To 13 Step 4
If numx = 13 Then numx = 10
session.findById("wnd[1]/usr/chk[2," & cstr(numx) & "]").Selected = True
next
Regards, ScriptMan
Related
I want to do a looping where it will filter by few categories. My idea was to set using numbers so it would be easier to loop. My idea
For i = 1 to 5
myTable.AutoFilter Field:=10, Criteria1:=i
....
....
Next i
But I have to declare my categories first, so I thought of doing something like
1 = "MEN"
2 = "WOMEN"
3 = "KIDS BOY"
4 = "KIDS GIRL"
5 = "UNISEX"
But it seems that I cannot do so. So does anyone have any other idea on how to loop filters or know how to declare with integers. Thanks
I'd do something of the likes:
Option Explicit
Sub Filters()
Dim MyFilter As Variant: MyFilter = setArrayFilters
Dim i As Long
For i = LBound(MyFilter) To UBound(MyFilter)
myTable.AutoFilter Field:=10, Criteria1:=MyFilter(i)
Next i
End Sub
Private Function setArrayFilters() As Variant
Dim x As Long: x = 5 'change this to redimension your array
Dim arr(1 To x)
arr(1) = "MEN"
arr(2) = "WOMEN"
arr(3) = "KIDS BOY"
arr(4) = "KIDS GIRL"
arr(5) = "UNISEX"
setArrayFilters = arr
End Function
I'm a beginner of VBA. My problem as title and I really don't know how to correct the code.Below is what I try but I think it's all wrong... Thanks in advance.
Sub Try_Click()
Dim i As Integer
Dim n As Integer
n = ThisWorkbook.Sheets("Sheet 1").Cells(3, 2).Value
For i = 1 To n
i = i * (i + 1)
Next i
ThisWorkbook.Sheets("Sheet 1").Cells(5, 2) = i
End Sub
Don't change i in the loop:
Sub Try_Click()
Dim i As Long
Dim n As Long
Dim prod As Long
n = ThisWorkbook.Sheets("Sheet 1").Cells(3, 2).Value
prod = 1
For i = 1 To n
prod = prod * i
Next i
ThisWorkbook.Sheets("Sheet 1").Cells(5, 2) = prod
End Sub
You need to add another variable to calculate it as below:
Sub Try_Click()
Dim i As Integer
Dim n As Integer
Dim k As Long
k = 1
n = ThisWorkbook.Sheets("Sheet2").Cells(3, 2).Value
For i = 1 To n
k = k * (i)
Next i
ThisWorkbook.Sheets("Sheet2").Cells(5, 2) = k
End Sub
As mentioned in comments, I also would have done:
Option Explicit
Public Sub Try_Click()
Dim n As Long
With ThisWorkbook.Sheets("Sheet 1")
n = .Cells(3, 2)
.Cells(5, 2) = Application.WorksheetFunction.Fact(n)
End With
End Sub
You need an additional variable for the result. Because if you change i within the For loop you fail the auto increment of the loop.
Also I recommend to use Long instead of Integer (for result). Why? Because for n > 7 it will already exceed the limits of Integer and throw an overflow error. Long at least lasts until n = 12. For more you will need to use Double but that will result in an approximated result for n > 18.
Option Explicit
Sub MultiplyN()
Dim i As Long
Dim n As Long
n = 10 'ThisWorkbook.Sheets("Sheet 1").Cells(3, 2).Value
Dim result As Long
result = 1
For i = 1 To n
Debug.Print result & " *" & i & "=" 'look this output in the intermediate window
result = result * i
Next i 'auto increments i
Debug.Print result
'ThisWorkbook.Sheets("Sheet 1").Cells(5, 2) = result
End Sub
Note that all Debug.Print lines are not needed to calculate but just to illustrate in the intermediate window what happens.
You can use #SJR suggestion in VBA if you don't want to use formula in cell B5:
=FACT(B3)
Code will be:
Sub Try_Click()
With ThisWorkbook.Sheets("Sheet 1").Cells(5, 2)
.FormulaR1C1 = "=FACT(R[-2]C)"
.Value = .Value
End With
End Sub
I want to make a sub, which determines if the cells in the 12th column starts with 262015. If it does start with this, it should create a new random 8-digit number starting with "18" and then 6 randomly created unique digits.
My code does not seem to figure out if the cell starts with 262015, and I have not been able to find help on creating the 8-digit number with these requirements.
Hope you can help me!
Sub Opgave8()
For i = 2 To 18288
If Left(Worksheets("arab").Cells(i, 12), 6) = "262015" Then
Worksheets("arab").Cells(i, 3) = "18" & studyid(6)
End If
Next i
Function UniqueRandDigits(x As Long) As String
Dim i As Long
Dim n As Integer
Dim s As String
Do
n = Int(Rnd() * 10)
If InStr(s, n) = 0 Then
s = s & n
i = i + 1
End If
Loop Until i = x + 1
UniqueRandDigits = s
End Function
End Sub
For i = 2 To 18288
If Left(Worksheets("Base").Cells(i, 12), 6) = "262015" Then
Worksheets("Base").Cells(i, 3) = "18" & Randdigits(6)
End If
Next i
Function RandDigits(x As Long) As String
Dim i As Long
Dim s As String
For i = 1 To x
s = s & Int(Rnd() * 10)
Next i
RandDigits = s
End Function
EDIT: here's one where all digits are different
Function UniqueRandDigits(x As Long) As String
Dim i As Long
Dim n As Integer
Dim s As String
Do
n = Int(Rnd() * 10)
If InStr(s, n) = 0 Then
s = s & n
i = i + 1
End If
Loop Until i = x + 1
UniqueRandDigits = s
End Function
EDIT2: And here is one that forces all numbers to be different
dim n as string
dim ok as boolean
For i = 2 To 18288
If Left(Worksheets("Base").Cells(i, 12), 6) = "262015" Then
ok = false
do
n = UniqueRandDigits(6)
If Application.WorksheetFunction.CountIf(Worksheets("Base").Range("L2:L18288"), n) = 0 Then
Worksheets("Base").Cells(i, 3) = "18" & n
ok = true
end if
loop until ok
End If
Next i
Using Left function, you need to specify the String, then the number of characters from the left, and then you check if it's equal to "262015".
Try the code below:
For i = 2 To 18288
If Left(Worksheets("Base").Cells(i, 12), 6) = "262015" Then
Worksheets("Base").Cells(i, 3) = "XXX"
End If
Next i
I am working on a project that includes multiples Excel files with cells containing English, Chinese, or both English and Chinese.
I need to keep the rows that are completely in Chinese and put them first. Then, I need lines with both Chinese characters and English. And only then those that are in English only.
I came across the following 3 functions that could help me mark the content accordingly, yet they do not seem to be working as expected, and I cannot figure out why.
Function ExtractChn(txt As String)
Dim i As Integer
Dim ChnTxt As String
For i = 1 To Len(txt)
If Asc(Mid(txt, i, 1)) < 0 Then
ChnTxt = ChnTxt & Mid(txt, i, 1)
End If
Next i
ExtractChn = ChnTxt
End Function
Function ExtractEng(txt As String)
Dim i As Integer
Dim EngTxt As String
For i = 1 To Len(txt)
If Asc(Mid(txt, i, 1)) >= 0 Then
EngTxt = EngTxt & Mid(txt, i, 1)
End If
Next i
ExtractEng = EngTxt
End Function
Function CheckTxt(txt)
Dim i As Integer
Dim Eng As Integer
Dim Chn As Integer
Chn = 0
Eng = 0
For i = 1 To Len(txt)
If Asc(Mid(txt, i, 1)) > 0 Then
Eng = 1
Else:
Chn = 1
End If
Next i
If Chn = 1 And Eng = 1 Then 'Contains Both Eng & Chn
CheckTxt = "BOTH"
Else:
If Chn = 1 And Eng = 0 Then 'Chn
CheckTxt = "CHN"
Else:
If Chn = 0 And Eng = 1 Then 'Eng
CheckTxt = "ENG"
End If
End If
End If
End Function
The person who created them even supplied a file demonstrating how the functions work. I am attaching the link to the file which has the arrangement as follows:
Text|English part of it|Chinese part of it|ExtractEng|ExtractChn|CheckTxt
According to the author's intentions, the CheckTxt result should display either CH, ENG, or BOTH. However, it is only displaying ENG at all times and I cannot figure why.
Any ideas how to make it work? Unless there is an easier way to 'advance-filter' the content in Excel? Any help will be much appreciated.
Test Excel file from the developer
This sounds like a job for Regular Expressions!!
Function getCharSet(Target As Range) As String
Const ChinesePattern = "[\u4E00-\u9FFF\u6300-\u77FF\u7800-\u8CFF\u8D00-\u9FFF]+"
Const EnglishPattern = "[A-Za-z]"
Dim results As String
Dim Data, v
Dim Regex1 As Object
Set Regex1 = CreateObject("VBScript.RegExp")
Regex1.Global = True
If Target.Count = 1 Then
Data = Array(Target.Value2)
Else
Data = Target.Value2
End If
For Each v In Data
If Not InStr(results, "CHN") Then
Regex1.Pattern = ChinesePattern
If Regex1.Test(v) Then
If Len(results) Then
getCharSet = "CHN" & " - " & results
Exit Function
Else
results = "CHN"
End If
End If
End If
If Not InStr(results, "ENG") Then
Regex1.Pattern = EnglishPattern
If Regex1.Test(v) Then
If Len(results) Then
getCharSet = results & " - ENG"
Exit Function
Else
results = "ENG"
End If
End If
End If
Next
getCharSet = results
End Function
A basic approach :
Sub Main()
Dim sh As Worksheet
Set sh = ActiveSheet
Dim rng As Range
Set rng = sh.Range("A6:D10")
Call Separate_English_Chinese(rng)
End Sub
Sub Separate_English_Chinese(rng)
Dim sh As Worksheet
Set sh = rng.Parent
Dim EnglishCharacters As String
Dim colEng As Long, colChn As Long, colContains As Long
Dim a As String, i As Long, k As Long
Dim colFullText As Long, txtEnglish As String, txtChinese As String
Dim Result As Long, Contains As String
Dim First As Long, Last As Long
First = rng.Row
Last = rng.Rows.Count + rng.Row - 1
EnglishCharacters = "qwertyuiopasdfghjklzxcvbnm"
EnglishCharacters = UCase(EnglishCharacters) & LCase(EnglishCharacters)
colFullText = 1
colEng = 2
colChn = 3
colContains = 4
For i = First To Last
a = sh.Cells(i, colFullText).Value
txtEnglish = ""
txtChinese = ""
For k = 1 To Len(a)
If InStr(EnglishCharacters, Mid(a, k, 1)) Then
txtEnglish = txtEnglish & Mid(a, k, 1)
Else
txtChinese = txtChinese & Mid(a, k, 1)
End If
Next
sh.Cells(i, colEng).Value = txtEnglish
sh.Cells(i, colChn).Value = txtChinese
Result = 0
If txtEnglish <> "" Then Result = Result + 1
If txtChinese <> "" Then Result = Result + 10
Select Case Result
Case 1
Contains = "ENG"
Case 10
Contains = "CHN"
Case 11
Contains = "BOTH"
Case Else
Contains = ""
End Select
sh.Cells(i, colContains).Value = Contains
Next
End Sub
I want to print a list of eight numbers to the worksheet, but only if they are all unique.
An ideal code would be something along the lines of
If a <> b <> c Then
Rather than
If a <> b And a <> c And b <> c Then
Is this possible, given that the values are called from an array using the code following:
Cells(2, 8) = numarr(i)
Cells(2, 9) = numarr(j)
Cells(2, 10) = numarr(k)
Cells(2, 11) = numarr(l)
Cells(3, 8) = numarr(m)
Cells(3, 9) = numarr(n)
Cells(3, 10) = numarr(o)
Cells(3, 11) = numarr(p)
Thanks!
The quick and dirty way to do this is with a Dictionary, which requires a unique key. Just keep dumping numbers in from your array until you hit one that's already in the Dictionary. Just make it into a function and pass your array to it:
Private Function AllUnique(incoming As Variant) As Boolean
If Not IsArray(incoming) Then Err.Raise 13
Dim candidates As Scripting.Dictionary
Set candidates = New Scripting.Dictionary
Dim index As Long
For index = LBound(incoming) To UBound(incoming)
If candidates.Exists(incoming(index)) Then Exit Function
candidates.Add incoming(index), index
Next index
AllUnique = True
End Function
I am going to throw in the direct comparison method:
Public Function AreEqual(ParamArray values() As Variant) As Boolean
Dim i As Long, j As Long, N As Long
Dim x As Double
N = UBound(values) + 1
For i = 1 To N - 1
x = values(i - 1)
For j = i + 1 To N
If values(j - 1) <> x Then
AreEqual = False
Exit Function
End If
Next j
Next i
AreEqual = True
End Function
To be used as
If AreEqual(num1,num2,num3,...) then
...
End If
As a slight variation of the Collection answer given above by #ja72, this function should be able to take any set of simple values of any type and determine if they're all identical or not. (The exception to this being the fourth test line for Strings, in which the Collection key is not case-sensitive.) I'm taking advantage of the hashing algorithm for adding keys to a Collection to ensure unique-ness.
Option Explicit
Sub Test()
Debug.Print AllValuesIdentical(14, 14, 14, 14, 14, 14, 14, 14, 14) 'true
Debug.Print AllValuesIdentical(5, 5, 5, 5, 5, 3, 5, 5) 'false
Debug.Print AllValuesIdentical("go", "go", "go", "go") 'true
Debug.Print AllValuesIdentical("go", "go", "go", "GO") 'also true
Debug.Print AllValuesIdentical(283.14, 283.14, 283.14) 'true
End Sub
Function AllValuesIdentical(ParamArray vals() As Variant) As Boolean
Dim uniqueCheck As Collection
Dim val As Variant
Set uniqueCheck = New Collection
On Error Resume Next
For Each val In vals
uniqueCheck.Add val, CStr(val)
Next val
If uniqueCheck.Count = 1 Then
AllValuesIdentical = True
Else
AllValuesIdentical = False
End If
On Error GoTo 0
Set uniqueCheck = Nothing
End Function