I wrote a macros that removes all the non-numeric characters from the logistics code and multiplies numbers left. On the pc it's okey, on my mac it doesn't work.
Here the code, probably someone could suggest me why the macros doesn't work on mac:
Function Bek(s)
Static re As Object
Dim x
If re Is Nothing Then
Set re = CreateObject("vbscript.regexp")
re.Pattern = "[0-9.,]+"
re.Global = True
End If
If re.test(s) Then
Bek = 1
For Each x In re.Execute(s)
Bek = Bek * Val(Replace(x, ",", "."))
Next
End If
End Function
I could also attach a file upon your request.
P.S. found some information, that the regexp might not be supported by mac os.
Very appreciate your help.
Try this.
It splits and looks at each part of the string and handles it the way I think you want.
Try it and see if it works
Sub ApplesWayOfRegex()
Str1 = "S10 2000*6000"
ReDim chars(Len(Str1) - 1)
For i = 1 To Len(Str1)
If (IsNumeric(Mid$(Str1, i, 1))) And i <> 1 Then
chars(i - 1) = Mid$(Str1, i, 1)
ElseIf (Not IsNumeric(Mid$(Str1, i, 1))) And i = 1 Then
chars(i - 1) = ""
Else
chars(i - 1) = "*"
End If
Next
Mathstr = Join(chars, "")
MsgBox Application.Evaluate(Mathstr)
End Sub
Related
I ran the below code looped for 6.5 thousand cells of criteria which are looked up against the range contained on the "LISTS" tab refered to. This range is some 20 thousand rows.
I ran the code numerous times yesterday in a test file and it ran very quickly. Maybe 2 minutes: if that.
Today, after deciding I was happy with the code, I've PASTED it (caps there because I'm wondering if that has something to do with it) into my main project.
Now when I run the code, it takes 2 hours plus!
I didn't change any of the code except for sheet names.
Does anyone know of any reason for this that I'm missing?
I'm new to VBA so I'm suspecting it's some rookie error somewhere!
Dim x As Long
x = WorksheetFunction.CountA(Columns(1))
'define string length for CELL loop
Dim char As Integer
char = Len(ActiveCell)
'define cell loop name
Dim counter As Integer
'Begin RANGE loop
For Each cell In Range("b1:b" & x)
cell.Activate
'Incorporate CELL loop
For counter = 1 To char
'Determine if numeric value present in cell = TRUE or FALSE
If IsNumeric(Right(Mid(ActiveCell, 1, counter), 1)) = True Then
ActiveCell.Offset(0, 1).Value = Right(ActiveCell.Offset(0, 0), Len(ActiveCell.Offset(0, 0)) - counter + 1)
Exit For
Else
ActiveCell.Offset(0, 1).Value = ActiveCell.Offset(0, 0)
End If
Next
Next
Try the code below, explanations inside the code's comments:
Dim x As Long
Dim char As Long 'define string length for CELL loop
Dim counter As Long 'define cell loop name
x = WorksheetFunction.CountA(Columns(1))
Application.ScreenUpdating = False ' will make your code run faster
Application.EnableEvents = False
'Begin RANGE loop
For Each cell In Range("b1:b" & x)
'cell.Activate ' <--- no need to Activate, realy slows down your code
'Incorporate CELL loop
For counter = 1 To char
'Determine if numeric value present in cell = TRUE or FALSE
If IsNumeric(Right(Mid(cell.Value, 1, counter), 1)) = True Then
cell.Offset(0, 1).Value = Right(cell.Value, Len(cell.Value) - counter + 1)
Exit For
Else
cell.Offset(0, 1).Value = cell.Value
End If
Next counter
Next cell
Application.ScreenUpdating = True
Application.EnableEvents = True
You need to avoid the ActiveCell, as far as it slows your code. You are looping with for-each thus you can use the variable in the loop like this:
For Each cell In Range("b1:b" & x)
For counter = 1 To char
If IsNumeric(Right(Mid(cell, 1, counter), 1)) = True Then
cell.Offset(0, 1).Value = Right(cell, Len(cell) - counter + 1)
Exit For
Else
cell.Offset(0, 1) = cell.Offset(0, 0)
End If
Next
Next
Furthermore, things like cell.Offset(0, 0) are a bit useless. If you do not need Offset, do not write it. And in general:
How to avoid using Select in Excel VBA
How To Speed Up VBA Code
Thanks to everyone who took the time to post on this one.
Turns out I'm an IDIOT!!!
The first time I ran the code, I dsiabled autocalculation, and all this time when I was re-running it, I'd commented it out.
I'm new to VBA but there's no excuse for that! Agh!
So, the fix (as suggested by others on the thread):
enter before main body of the macro:
Application.Calculation = xlCalculationManual
then after the macro, enter:
Application.Calculation = xlCalculationAutomatic
Sub guessLetter(letterGuess As String)
Dim lengthOfSecretWord As Integer
lengthOfSecretWord = Len(Secret_word) - 1
tempWord = ""
Dim letterPosition As Integer
For letterPosition = 0 To lengthOfSecretWord
If Mid(Secret_word, letterPosition, 1) = letterGuess Then
tempWord = tempWord & letterGuess
Else
tempWord = tempWord & Mid(lblTempWord, letterPosition, 1)
End If
Next
lblTempWord = tempWord
End Sub
I have runtime error "5" and the problem in line IF, i'm stuck to declare Secret_word.substr(letterPosition, 1) on vb6, first i try write Secret_word.substr(letterPosition, 1) but it can't then i try to manipulate that then runtime error 5 came
The Mid Function in VB (like most things in VB) is 1-indexed, not 0-indexed.
I'm assuming you're familiar with other languages in which you would loop from 0 to Len(String)-1, but VB thinks you'll find it more intuitive to loop from 1 to Len(String).
Refer to the description and example in the documentation for more details.
hi all i have this question as bellow
how capitalize full in one vb6 Vb6 string variable
‘example
‘my fullname
Dim fullname as string
Fullname = “abdirahman abdirisaq ali”
Msgbox capitalize(fullname)
it prints abdirahmanAbdirisaq ali that means it skips the middle name space even if I add more spaces its same .
this is my own code and efforts it takes me at least 2 hours and still .
I tired it tired tired please save me thanks more.
Please check my code and help me what is type of mistakes I wrote .
This is my code
Private Function capitalize(txt As String) As String
txt = LTrim(txt)
temp_str = ""
Start_From = 1
spacing = 0
For i = 1 To Len(txt)
If i = 1 Then
temp_str = UCase(Left(txt, i))
Else
Start_From = Start_From + 1
If Mid(txt, i, 1) = " " Then
Start_From = i
spacing = spacing + 1
temp_str = temp_str & UCase(Mid(txt, Start_From + 1, 1))
Start_From = Start_From + 1
Else
temp_str = temp_str & LCase(Mid(txt, Start_From, 1))
End If
End If
Next i
checkName = temp_str
End Function
It's far simpler than that. In VB6 you should use Option Explicit to properly type your variables. That also requires you to declare them.
Option Explicit
Private Function capitalize(txt As String) As String
Dim temp_str as String
Dim Names As Variant
Dim Index As Long
'Remove leading and trailing spaces
temp_str = Trim$(txt)
'Remove any duplicate spaces just to be sure.
Do While Instr(temp_str, " ") > 0
temp_str = Replace(temp_str, " ", " ")
Loop
'Create an array of the individual names, separating them by the space delimiter
Names = Split(temp_str, " ")
'Now put them, back together with capitalisation
temp_str = vbnullstring
For Index = 0 to Ubound(Names)
temp_str = temp_str + Ucase$(Left$(Names(Index),1)) + Mid$(Names(Index),2) + " "
Next
'Remove trailing space
capitalize = Left$(temp_str, Len(temp_str) - 1)
End Function
That's the fairly easy part. If you are only going to handle people's names it still needs more work to handle names like MacFarland, O'Connor, etc.
Business names get more complicated with since they can have a name like "Village on the Lake Apartments" where some words are not capitalized. It's a legal business name so the capitalization is important.
Professional and business suffixes can also be problematic if everything is in lower case - like phd should be PhD, llc should be LLC, and iii, as in John Smith III, would come out Iii.
There is also a VB6 function that will capitalize the first letter of each word. It is StrConv(string,vbProperCase) but it also sets everything that is not the first letter to lower case. So PhD becomes Phd and III becomes Iii. Where as the above code does not change the trailing portion to lower case so if it is entered correctly it remains correct.
Try this
Option Explicit
Private Sub Form_Load()
MsgBox capitalize("abdirahman abdirisaq ali")
MsgBox capitalize("abdirahman abdirisaq ali")
End Sub
Private Function capitalize(txt As String) As String
Dim Names() As String
Dim NewNames() As String
Dim i As Integer
Dim j As Integer
Names = Split(txt, " ")
j = 0
For i = 0 To UBound(Names)
If Names(i) <> "" Then
Mid(Names(i), 1, 1) = UCase(Left(Names(i), 1))
ReDim Preserve NewNames(j)
NewNames(j) = Names(i)
j = j + 1
End If
Next
capitalize = Join(NewNames, " ")
End Function
Use the VB6 statement
Names = StrConv(Names, vbProperCase)
it's all you need (use your own variable instead of Names)
Is there any way by which we can get each character from a string using VBScript? I had used the Mid function but I just want to know if there are any other direct functions which when used returns each character starting from a string.
strString = "test"
For i=1 To Len(strString)
WScript.Echo Mid(strString,i,1)
Next
a="abcd"
for i=1 to len(a)
msgbox right(left(a,i),1)
next
AFAIK, Mid is the only way to do this.
Another way to do it, starting from 0 :
str = "hola che"
x=Len(str)
text = ""
For i=0 to x-1 'x-1 is because it exceeds the actual length
text= text & Mid(str,i+1,1)
Next
msgbox text
This code is useful to split Ucase and Lcase
Dim a
a="StAcKoVeRfLoW"
for i=o to len(a)-1
if mid(a,i+1,1)=ucase(mid(a,i+1,1)) then
b=mid(a,i+1,1)
msgbox b
end if
next
This works for me. LEFT and then RIGHT....
'Ugandan National Identity Number (NIN) has 14 digits
strFullNIN = "18650929392010"
strNIN_1 = LEFT(strFullNIN,1)
strNIN_2 = RIGHT(LEFT(strFullNIN,2),1)
strNIN_3 = RIGHT(LEFT(strFullNIN,3),1)
strNIN_4 = RIGHT(LEFT(strFullNIN,4),1)
strNIN_5 = RIGHT(LEFT(strFullNIN,5),1)
strNIN_6 = RIGHT(LEFT(strFullNIN,6),1)
strNIN_7 = RIGHT(LEFT(strFullNIN,7),1)
strNIN_8 = RIGHT(LEFT(strFullNIN,8),1)
strNIN_9 = RIGHT(LEFT(strFullNIN,9),1)
strNIN_10 = RIGHT(LEFT(strFullNIN,10),1)
strNIN_11 = RIGHT(LEFT(strFullNIN,11),1)
strNIN_12 = RIGHT(LEFT(strFullNIN,12),1)
strNIN_13 = RIGHT(LEFT(strFullNIN,13),1)
strNIN_14 = RIGHT(LEFT(strFullNIN,14),1)
If I didn't know the length of the initial string, I would do as follows:
strFullNIN = RS.fields("Client_NIN")
strFullNIN_LENGTH = LEN(strFullNIN)
x = 1
DO UNTIL x = strFullNIN_LENGTH
IF x = 1 THEN
strNIN_"& x &" = LEFT(strFullNIN,x)
ELSE
strNIN_"& x &" = RIGHT(LEFT(strFullNIN,x),1)
END IF
x=x+1
LOOP
Hope this is helpful to someone!
Example
G76 I0.4779 J270 K7 C90
X20 Y30
If a number begins with I J K C X Y and it doesn't have a decimal then add decimal.
Above example should look like:
G76 I0.4779 J270 K7. C90.
X20. Y30.
Purpose of this code is to convert CNC code for an older Fanuc OPC controller
Set RegEx = New RegExp
RegEx.Global = True
RegEx.Pattern = "([IJKCXY]\d+)([^\.]|$)"
newVar = RegEx.Replace (oldString, "$1.$2")
Where oldString is the original string, and newVar is the string with the decimals added.
function convert(str)
Set RegEx = New RegExp
RegEx.Global = True
RegEx.Pattern = "([IJKCXY]\d*\.?\d*)"
Set Matches = regEx.Execute(str)
For Each Match in Matches
if instr(Match.value, ".") = 0 then
str = Replace(str, Match.value, Match.value & ".")
end if
Next
convert = str
end function
tloach still answer doesn't work
Waynes works but also puts a . after every occurrence of IJKCXY
I changed if instr(Match.value, ".") = 0 then
To be like if instr(Match.value, ".") = 0 and len(Match.value) > 1 then