Limit text to allowed characters only - (not by enumerating the wrong characters) | VBA - string

I would like to limit certain textboxes to accept only [A-Za-z]
I hope, a counterpart to Like exists.
With Like I would have to make a long list of not allowed characters to be able to filter.
Not MyString like [?;!°%/=....]
I can think of a solution in the form of:
For Counter = 1 To Len(MyString)
if Mid(MyString, Counter, 1) Like "*[a-z]*" = false then
MsgBox "String contains bad characters"
exit sub
end if
next
... but is there a more sophisticated 1liner solution ?
Until then, I have created a function to make it "Oneliner":
Function isPureString(myText As String) As Boolean
Dim i As Integer
isPureString = True
For i = 1 To Len(myText)
If Mid(myText, i, 1) Like "*[a-zA-Z_íéáűúőöüóÓÜÖÚŐŰÁÉÍ]*" = False Then
isPureString = False
End If
Next
End Function
If i add 1 more parameter, its also possible to define the allowed characters upon calling the function.

Ok, it seems my question was a bit of a duplicate, even though that did not pop in my search results.
So credits for #QHarr for posting the link.
The solution I can forge from that idea for my "oneliner" is:
If myText Like WorksheetFunction.Rept("[a-zA-Z]", Len(myText))=false then 'do something.
Using .rept is inspiringly clever and elegant in my oppinion.
So what is does: Multiplies the search criteria for each charater instead of looping through the characters.
EDIT:
In an overaboundance of nice and elegant solutions, the most recent leader is:
If not myText Like "*[!A-Za-z]*" then '... do something
Statistics update:
I have tested the last 3 solutions' performance:
I have pasted # in the below text strin at the beginning, at the end or nowhere.
The criteria were: "*[a-zA-Z \S.,]*"
For 100000 repetitions
text = "This will be a very Long text, with one unwanted in the middle, to be able to test the difference in performance of the approaches."
1.) Using the [!...] -> 30ms with error, 80ms if no error
2.) Using .Rept -> around 1800ms for all cases
3.) Using characterLoop+Mid -> around 3000ms if no error / 40-80ms ms if early error

Related

Comparing Best Times not always working correctly and not sure why

This is for VB.NET 2017. I am creating a program and keeping score with the best time. The timer in the program runs like a stopwatch. I would like at the end to compare the best record from a past game with the current time of a new game. If the new game has a faster time then I would like to replace it on the data file. I can do that just fine but sometimes it will put a slower time ahead of the fastest time. I have tried multiple scenarios and cannot get it consistent. If anyone could help that would be appreciated very much. I have some message boxes so I can see some outcomes. They will be commented out later when it is working properly.
If TotalBalls = 2 And SelectPoison = 2 Then
tmrTime.Enabled = False
CurrentScore = lblTime.Text
MsgBox("You win.")
'''''''''''''''''''''''''''''''''''''''''''''''''''
' CurrentScore = lblTime.Text
MsgBox("Current Time is " & CurrentScore)
NewScoreCheck = String.Compare(CurrentScore, RecordHighScore)
MsgBox(NEwScoreCheck)
'NewScoreCheck will be less than 0 if CurrentScore is less (alphabetically) than RecordhighScore
'NewScoreCheck will be greater than 0 if RecordHighSchore is greater than CurrentScore
If NewScoreCheck < 0 Then
MsgBox(CurrentScore)
Try
MsgBox("In the try statement. Writing new time")
Dim FileWrite As System.IO.StreamWriter
FileWrite = New System.IO.StreamWriter("PoisonHighScore.TXT", False)
FileWrite.WriteLine(CurrentScore)
FileWrite.Close()
Catch
MsgBox("Saving error")
End Try
Else
MsgBox("Not the fastest time.")
End If
Else
MsgBox("You lose.")
End If
strExit = MsgBox("Do you want to play again?", vbYesNo)
If strExit = vbYes Then
Application.Restart()
End If
End Sub
Edit 1: I am using some variables as TimeSpan which is why I have the values CurrentScore and RecordHighScore as Strings. When I am using TimeSpan it will not store as an Integer and will return an error. I am looking for a way to compare two times but need to store them in such a way that they can be compared which is why I used the compare string method mentioned above. I understand after looking at the solution below as to why I cannot. My question now becomes how do I store them since it cannot be stored as double, single, or integer?
To make it a little more clear think of two racers who finish with two different times and those times being unpredictable. The fastest time would win and we would write to the text file (which I know how to do) the time of the winner.
P.S. I have also tried the CInt(CurrentScore) < CInt(RecordHighScore) but that just returns an error too. Any help again would be greatly appreciated and thank you for taking the time to help me with this.
Right off the bat it looks like you're doing some implicit type conversions such as:
CurrentScore = lblTime.Text
Presumably CurrentScore is a numeric data type (like an Integer or Double), but you're setting the value equal to a String. To correct those errors, turn Option Strict on. Looking even deeper, this appears to be your problem because you use the String.Compare method to compare the scores alphabetically. To give you an example, String.Compare returns -1 when you pass 1112 and 121 as your current score and high score respectively, but obviously 121 is quicker than 1112.
What you need to do is convert all numeric values as numeric data types and then compare them using the appropriate comparison operator.
If you want the Timer to behave like a stopwatch then why not use a StopWatch? If you use a StopWatch, you can get the ElapsedMilliseconds which returns a long. The Stop method only pauses the timer; you need to call the Reset method to reset the StopWatch to zero. Call this after you collect the ElapseMilliseconds into a variable.
NewScoreCheck = String.Compare(CurrentScore, RecordHighScore) Strings are not compared in the same way numbers are.
Dim a As String = "72"
Dim b As String = "100"
If String.Compare(a, b) < 0 Then
MessageBox.Show("a comes first")
Else
MessageBox.Show("b comes First")
End If
Result b comes first!
Using a MsgBox to check values is not a great idea. Visual Studio has all sorts of great debugging tools. Inevidibly you will forget to remove a MsgBox; I have :-). Use Debug.Print which will not be in the release version.
Dim sw As New Stopwatch()
Private Sub BeginGame()
sw.Start()
End Sub
Private Sub OPCode2()
Dim TimeInMilliseconds As Long = sw.ElapsedMilliseconds
Dim TotalBalls As Integer = 2
Dim SelectPoison As Integer = 2
Dim RecordHighScore As Long
Dim CurrentScore As Long
If TotalBalls = 2 And SelectPoison = 2 Then
sw.Stop()
CurrentScore = sw.ElapsedMilliseconds
sw.Reset() 'So you can play again and get a new time
MsgBox("You win.")
'''''''''''''''''''''''''''''''''''''''''''''''''''
Debug.Print($"Current Time is {CurrentScore}")
If CurrentScore > RecordHighScore Then
Try
Debug.Print("In the try statement. Writing new time")
Dim FileWrite As System.IO.StreamWriter
FileWrite = New System.IO.StreamWriter("PoisonHighScore.TXT", False)
FileWrite.WriteLine(CurrentScore.ToString)
FileWrite.Close()
Catch
MsgBox("Saving error")
End Try
Else
MsgBox("Not the fastest time.")
End If
Else
MsgBox("You lose.")
End If
Dim strExit As MsgBoxResult
strExit = MsgBox("Do you want to play again?", vbYesNo)
If strExit = vbYes Then
'Not a good way to do this, clear your variables and UI
Application.Restart()
End If
End Sub

Excel VBA On Error error

I am rather new at programming, and while learning Python also started experimenting with Excel VBA. I have an issue with the last one.
I have some large Excel sheets and tried to validate that data in specific columns matches data on another sheet in certain columns as they will be supposed to relate to each other by these values (and will be connected by a third value). To make this a bit more difficult, both of these columns may contain more than one value separated by "|". So, I have split these values in a list and I try to iterate through them to make sure all these values are set correctly, the connection will work fine.
All is fine as long as all is fine :) I have however an issue where there are two values in one of those columns and only one in the other. I would like this discrepancy to be noted on a sheet and then proceed to the next item.
The way that seemed to be applicable for me is to use "On Error GoTo ErrHandler", then note error on another sheet, and then user Resume to proceed.
Here is what I came up with:
For h = 0 To UBound(Split1())
For j = 1 To GetMaxRow("SpecificSheet", A)
On Error GoTo ErrHandler:
If Sheets("SpecificSheet").Cells(j, 1).Value = Split1(h) And Sheets("SpecificSheet").Cells(j, 2).Value = Split2(h) Then
DependencyOk = DependencyOk + 1
End If
Next j
Next h
ErrProceed:
Also ErrHandler is:
ErrHandler:
Sheets("Issues").Cells(x, 1) = "IssueDescription"
GoTo ErrProceed
It stops at line 2 with Subscript out of range for Split2(h) rather than moving on to ErrHandler and then ErrProceed. I have the feeling this must be something very obvious but I am just unable to get this working, and I am not able to find other way (like a try/except) in Excel VBA.
UPDATE:
Trying to clarify things a bit. The root of the issue is, that the Split2 list is shorter than Split1 - which is an issue with the input data and I'd like to capture this. I get the Split values from cells, where the values are separated by "|" characters:
CellValue = Sheets("SomeSheet").Cells(RowNumber, ColumNumber)
CellValueSplit() = Split(CellValue, "|")
And then iterate as:
For h = 0 To UBound(Split1())
So as Split1 moves on to the for example 3rd value, Split2 throws error and script stops. The best I was able to do so far was, that I let it proceed with the loop, but as this is a rather large sheet, it will fill the same error report ca. 200k times in this case, which I'd like to avoid. So I'd prefer it to proceed from after this loop once it hits out of range error, and proceed examining the next value.
Thank you for your help so far and in advance!
You have an issue with your syntax. The proper Error statement syntax is:
On Error GoTo <string>
On Error Resume Next
On Error GoTo 0
When using On Error GoTo <string> there is no ":" at the end. The ":" doesn't come into play until you create the target location. Example:
On Error GoTo Here
'// ---- Do something ---- //
Here:
'// ---- Handle the error ---- //
If you use On Error Resume Next, then you're telling the machine to ignore errors and proceed on to the next line of code.
When you useOn Error Return To 0, VBA will reset its error handling back to default. It's a good habit when using On Error Resume Next to insert On Error Return To 0 as soon as you no longer need it. On Error Resume Next has a real potential to break your code and make it behave strangely. Not to mention debugging can be a real nightmare. Check out the VBA manual from Microsoft for a more detailed explanation.
Finally, if your question is answered, you should mark it as answered.
vba-excelvbaexcel
The short and quick version is that VBA Error Handling Routine's only handle errors in the actual code execution, they do not fire when conditions expressed by the code are not met.
In your case, you do not need any error handling at all. In most cases it is actually best to avoid On Error GoTo .... There are cases where it's inevitable, but they are rare.
Try this IF THEN ELSE block:
If Sheets("SpecificSheet").Cells(j, 1).Value = Split1(h) And Sheets("SpecificSheet").Cells(j, 2).Value = Split2(h) Then
DependencyOk = DependencyOk + 1
Else
Sheets("Issues").Cells(x, 1) = "IssueDescription"
End If
Actually I have just found the issue. It was caused by a ":" left after an If statement a few rows earlier. I still don't really understand what it did, but I suggest not to reproduce it :)

Way too long of a function but I need it - can it be done in VBA?

Because of severe lack of knowledge, I made a ridiculously long function so that I could make my calculation. The problem is that it is too long for Excel, and I tried looking online to see how I could maybe make a new function in VBA that referenced my function. I'm super lost on this one and any help would be awesome. The function would just be too messy to post here (it is 30k characters long).
Ok so here it goes - here's a part of the function:
=+IF(ISERROR(IF(LEFT(C12,FIND(" ",C12,1))=$C$2,SUMPRODUCT(P12:S12,Selection!$B$4:Selection!$E$4),IF(LEFT(C12,FIND(" ",C12,1))=$C$3,SUMPRODUCT(P12:S12,Selection!$B$5:Selection!$E$5),IF(LEFT(C12,FIND(" ",C12,1))=$C$4,SUMPRODUCT(P12:S12,Selection!$B$6:Selection!$E$6),IF(LEFT(C12,FIND(" ",C12,1))=$C$5,SUMPRODUCT(P12:S12,Selection!$B$7:Selection!$E$7),IF(RIGHT(C12,LEN($C$6))=$C$6,SUMPRODUCT(P12:S12,Selection!$B$8:Selection!$E$8),IF(RIGHT(C12,LEN($C$7))=$C$7,SUMPRODUCT(P12:S12,Selection!$B$9:Selection!$E$9),IF(RIGHT(C12,LEN($C$8))=$C$8,SUMPRODUCT(P12:S12,Selection!$B$10:Selection!$E$10),SUMPRODUCT(P12:S12,Selection!$B$11:Selection!$E$11))))))))),1,IF(LEFT(C12,FIND(" ",C12,1))=$C$2,SUMPRODUCT(P12:S12,Selection!$B$4:Selection!$E$4),IF(LEFT(C12,FIND(" ",C12,1))=$C$3,SUMPRODUCT(P12:S12,Selection!$B$5:Selection!$E$5),IF(LEFT(C12,FIND(" ",C12,1))=$C$4,SUMPRODUCT(P12:S12,Selection!$B$6:Selection!$E$6),IF(LEFT(C12,FIND(" ",C12,1))=$C$5,SUMPRODUCT(P12:S12,Selection!$B$7:Selection!$E$7),IF(RIGHT(C12,LEN($C$6))=$C$6,SUMPRODUCT(P12:S12,Selection!$B$8:Selection!$E$8),IF(RIGHT(C12,LEN($C$7))=$C$7,SUMPRODUCT(P12:S12,Selection!$B$9:Selection!$E$9),IF(RIGHT(C12,LEN($C$8))=$C$8,SUMPRODUCT(P12:S12,Selection!$B$10:Selection!$E$10),SUMPRODUCT(P12:S12,Selection!$B$11:Selection!$E$11)))))))))
To answer your question "Can it be done in VBA?", the answer is yes. If you can do it with excel functions you can do it with VBA. There may be functional disadvantages though, and coding the function will have completely different syntax (although it is usually pretty easy to translate using google searches).
One thing to consider before you go to VBA though is could the function be broken up into multiple cells? This might suit your needs and get around the character limit, although if it's 30k characters long this might not be practical or even possible to do this.
I would recommend starting out by literally googling "VBA equivalent of excel function XXXX" for each excel function you use. Then work your way inside out from the middle parentheses to perform operations on the inputs in the same order as your excel function. The main difference between VBA functions and Excel functions is that you can perform operations on the same variable line by line instead of using complicated order of operations.
For example, instead of putting =if(a2>3,b3+5,b3-5)*if(A1>3,B2+3,B2-3), you could put:
Function Your_Function_Name1(Cell_one As Range, Cell_two As Range, _
Cell_three As Range, Cell_four As Range) As Double
If Cell_four > 3 Then
If Cell_three > 3 Then
Your_Function_Name1 = (Cell_one.Value + 5) * (Cell_two.Value + 3)
Else
Your_Function_Name1 = (Cell_one.Value - 5) * (Cell_two.Value + 3)
End If
Else
If Cell_three > 3 Then
Your_Function_Name1 = (Cell_one.Value + 5) * (Cell_two.Value - 3)
Else
Your_Function_Name1 = (Cell_one.Value - 5) * (Cell_two.Value - 3)
End If
End If
End Function
and call by =Your_Function_Name1(B3,B2,A2,A1). But it is also perfectly legitimate and usually easier to do this instead:
Function Your_Function_Name(Cell_one As Range, Cell_two As Range, _
Cell_three As Range, Cell_four As Range) As Double
If Cell_three > 3 Then
Your_Function_Name = Cell_one.Value + 5
Else
Your_Function_Name = Cell_one.Value - 5
End If
If Cell_four > 3 Then
Your_Function_Name = Your_Function_Name * (Cell_two.Value + 3)
Else
Your_Function_Name = Your_Function_Name * (Cell_two.Value - 3)
End If
End Function
Both of these functions would be called the same way and yield the same result.
I think that should be enough to get you started, although you will probably end up be posting another question or two once you get into it and start debugging, but at least you will have specific code to ask about. VBA is hard at first but it is worth the time you put into it.
Good Luck!
The following guideline is a great way both to refactor your existing code, and to write new code in future:
For every block of code that has, or is big enough to have, a descriptive comment, make a subroutine and name it (in PascalCase) with the descriptive comment. Identify all local variables and redeclare them in the new subroutine. Pass in all global values as named parameters.
Rinse and Repeat until all subroutines are less than 40 lines or so.
You can cut your function in half by using IFERROR rather than IF(ISERROR
also, your Selection!$B$4:Selection!$E$4 can be reduced to Selection!$B$4:$E$4
=IFERROR(IF(LEFT(C12,FIND(" ",C12,1))=$C$2,SUMPRODUCT(P12:S12,Selection!$B$4:$E$4),IF(LEFT(C12,FIND(" ",C12,1))=$C$3,SUMPRODUCT(P12:S12,Selection!$B$5:$E$5),IF(LEFT(C12,FIND(" ",C12,1))=$C$4,SUMPRODUCT(P12:S12,Selection!$B$6:$E$6),IF(LEFT(C12,FIND(" ",C12,1))=$C$5,SUMPRODUCT(P12:S12,Selection!$B$7:$E$7),IF(RIGHT(C12,LEN($C$6))=$C$6,SUMPRODUCT(P12:S12,Selection!$B$8:$E$8),IF(RIGHT(C12,LEN($C$7))=$C$7,SUMPRODUCT(P12:S12,Selection!$B$9:$E$9),IF(RIGHT(C12,LEN($C$8))=$C$8,SUMPRODUCT(P12:S12,Selection!$B$10:$E$10),SUMPRODUCT(P12:S12,Selection!$B$11:$E$11)))))))),1)
Now that worked for me, but your test of LEFT(C12,FIND(" ",C12,1))=$C$2 seems suspect. If C12 contain Cat in the House, the left side would evaluate to
"Cat "
with a space on the end. That would be fine in the cells you are testing against contain a space on the end, but I would guess they don't. You might want to make the text
LEFT(C12,FIND(" ",C12,1)-1)=$C$2

What does the number in the AddChart2 VBA macro represent?

I've use my Excel 2013 to record a macro in inserting a chart, a column-clustered chart in my case. In the view code option, it shows me a line of code as below:
ActiveSheet.Shapes.Addchart2(286,xl3DColumnClustered).Select
Please help me as I cannot understand what does the number 286 represent. I know the syntax of Addchart2 is:
expression.AddChart2(Style,XlChartType,Left,Top,Width,Height,NewLayout)
If I change the "286" to "285", the chart appears with a blue background. An error comes out if the number is 100.
Can anyone kindly tell me what does the number represent?
One can also provide only the ChartType and the application will use the default style.
Set oShp = ActiveSheet.Shapes.AddChart2(XlChartType:=xl3DColumnClustered)
oShp.Chart.SetSourceData Source:=RngDta
This picture shows the default ChartStyle for all ChartTypes (excluding StockHLC and StockVOHLC)
This won't directly answer your question, but it will help you figure out what is going on.
This is pure conjecture on my part, but I would guess it's an undocumented bitfield. As you may know a bit field is just a way to use a number. So image we have a Byte variable which can be 8 bits (or flags). So in a byte we can store up to 8 values.
Example: We have field called "DaysOpen" bits 1-7 mean the store is open on that day of the week. (We'll ignore the 8th bit.) So if the store is open M-F that would be binary 0111 1100.
Then you just convert that number to decimal and we see that it's 124.
That variable is a Variant so it could be anything from a Byte to Long meaning it could be storing up to 64 different flags.
As a side note (if you are interested) you can use bit fields like so:
Option Explicit
Public Enum DayFlags
'Notice these are power of 2.
dfSunday = 1
dfMonday = 2
dfTuesday = 4
dfWednesday = 8
dfThursday = 16
dfFriday = 32
dfSaturday = 64
End Enum
Sub Example()
Dim openHours As DayFlags
'Set the flags:
openHours = dfMonday Or dfTuesday Or dfThursday
'See the binary?
MsgBox Right$("00000000" & Excel.WorksheetFunction.Dec2Bin(openHours), 8)
'Notice the order is right to left. This is call endianness.
'You can check for a specific flag like this:
MsgBox IsOpenOnDay(openHours, dfMonday) & vbNewLine & IsOpenOnDay(openHours, dfFriday)
'You can add a flag like this:
openHours = openHours Or dfFriday
MsgBox IsOpenOnDay(openHours, dfMonday) & vbNewLine & IsOpenOnDay(openHours, dfFriday)
'You can remove a flag like this:
openHours = openHours Xor dfFriday
MsgBox IsOpenOnDay(openHours, dfMonday) & vbNewLine & IsOpenOnDay(openHours, dfFriday)
End Sub
Private Function IsOpenOnDay(ByVal openHours As DayFlags, ByVal day As DayFlags) As Boolean
IsOpenOnDay = ((openHours And day) = day)
End Function
Well , I had the same situation once, and those are basically chart styles. I tried to figure out the exact numbering but then i realized that recording was a much easier way of knowing the style numbers just as you have done here.
To answer you question, record macros to know which style you want to implement in your macros.
Just checking to see if 5 years later anyone has a better answer. I sure could use an enumeration of the chart styles; I don't like putting simple numbers in my code without some explanation as to what it means. Of course, I could use a comment, but if the numbers are documented, then that means they could change.
I found a partial list: https://learn.microsoft.com/en-us/office/vba/api/excel.xlcharttype
I'm sure these numbers, plus the bitfield variations as suggested by Pillgram above to control various other chart aspects, answer the question. The possible combinations are in the thousands, so a full list would be pretty useless. Recording is still your best bet.

Excel UDF not appearing in drop down menu

I wrote a User Defined Fucntion in Excel. It works great with no issues. I even wrote a description for it under the object properties menu.
The problem is, my UDF never shows up in the Excel drop down menu that appears when I start to type a function. I want the user to be able to see my UDF, named removeNumbers, when they go into a cell and start to type out a function.
I would also like them to be able to see the description which I wrote, just like the standard Excel functions.
And finally, is there a way that I can provide a description for each argument which my function takes as input?
Here is the actual code, although I don't think it will be necessary to answer my questions.
Function removeNumbers(sInput As String, sChoice As Boolean) As String
Dim sSpecialChars As String
Dim i As Long
If (sChoice = True) Then 'if true is selected, will remove all number including 0
sSpecialChars = "0123456789" 'This is your list of characters to be removed
For i = 1 To Len(sSpecialChars)
sInput = Replace$(sInput, Mid$(sSpecialChars, i, 1), "")
Next
End If
If (sChoice = False) Then 'if false is selected, will remove all numbers excluding zero
sSpecialChars = "123456789" 'This is your list of characters to be removed
For i = 1 To Len(sSpecialChars)
sInput = Replace$(sInput, Mid$(sSpecialChars, i, 1), "")
Next
End If
removeNumbers = sInput
End Function
To make the function appear in the drop-down you must place it in a standard module rather than the worksheet code area.
Another poster has already covered the need for the code to be in a standard module. With regards the argument descriptions, you should look at the MacroOptions code in this answer - although it only works in Excel 2010 or later.
For Excel 2007 and earlier, the only solution I have seen is in an article by JK Pieterse. This involves using the ExecuteExcel4Macro and looks a bit complicated.

Resources