I have tried to change the code but it didnt works.
Here is my code:
Private Sub CTcash_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
bill = Val(CTcash.Text - CLtotaloutput.Caption)
If Val(bill) > 0 Then
Change.CLchange.Caption = Val(bill)
Change.CLchange.Caption = Format(bill, "Rp\. ###,###,###.-")
Change.Show
End If
If Val(bill) < 0 Then
MsgBox "Not Enough Money", vbOKOnly, "Invalid"
End If
End If
End Sub
The highlighted code
bill = Val(CTcash.Text - CLtotaloutput.Caption)
Both CTcash.Text and CLTotaloutput.Caption are text strings so you can't subtract them directly. Try:
bill = Val(CTcash.text) - Val(CLtotaloutput.Caption)
You really should ensure that both strings are numerical first though!
#John Eason is correct. You also do not have to use Val on bill since it is already an integer. And you are not doing anything if bill is 0 but this could be fine based on your requirements.
Private Sub CTcash_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
bill = Val(CTcash.Text) - Val(CLtotaloutput.Caption)
If bill > 0 Then ' Note that when bill is 0 nothing happens but that might be fine
'Change.CLchange.Caption = bill 'Not sure why this is needed but it may be
Change.CLchange.Caption = Format(bill, "Rp\. ###,###,###.-")
Change.Show
End If
If bill < 0 Then
MsgBox "Not Enough Money", vbOKOnly, "Invalid"
End If
End If
End Sub
I think a better approach would be to use a Select Case statement.
Private Sub CTcash_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
bill = Val(CTcash.Text) - Val(CLtotaloutput.Caption)
Select Case True
Case bill > 0
Change.CLchange.Caption = Format(bill, "Rp\. ###,###,###.-")
Change.Show
Case bill < 0
MsgBox "Not Enough Money", vbOKOnly, "Invalid"
Case Else
' Do nothing - this documents that this is done on purpose
End Select
End If
End Sub
You can use IsNumeric function to check if the inputs are numeric and parse accordingly. Use the Right function to remove any non-numbers from the left side. For example, Right("$123", Len("$123") - 1) will remove the leading $.
To strip all non-numerical values from a string:
Dim ResultString As String
myString = "aaa34BB12,000xcv9.9zz"
Dim i As Integer
For i = 1 To Len(myString)
myChar = Mid(myString, i, 1)
If IsNumeric(myChar) = True Then
ResultString = ResultString + myChar
End If
Next
MsgBox ResultString
Note that this may cause an issue with decimal amounts since 1.23 will before 123. Not something you want. Try using the CCur function. I have never used it myself but it might be exactly what you want.
Source: https://www.vbforums.com/showthread.php?437526-RESOLVED-Removing-non-numeric-chars-from-a-string&p=2686411&viewfull=1#post2686411
At first I miss the const, i put it in the other sub:
Private Sub CTcash_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
bill = Val(CTcash.Text) - totalsum
Select Case True
Case bill > 0
Change.CLchange.Caption = Format(bill, "Rp\. ###,###,###.-")
Change.Show
Case bill < 0
MsgBox "Not Enough Money", vbOKOnly, "Invalid"
Case Else
End Select
End If
End Sub
Private Sub CTbarcode_KeyUp(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case Is = vbKeyF6
totaldiscount = 200
totalsum = Val(CLsuboutput.Caption) - totaldiscount
CLtotaloutput.Caption = Format(totalsum, "Rp\. ###,###,###. ,-")
CLdiscoutput.Caption = Format(totaldiscount, "Rp\. ###,###,###. ,-")
CTcash.Enabled = True
CTcash.SetFocus
End Select
End Sub
Here is it after i edit it:
Private Sub CTcash_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
totaldiscount = 200
totalsum = Val(CLsuboutput.Caption) - totaldiscount
bill = Val(CTcash.Text) - totalsum
Select Case True
Case bill > 0
Change.CLchange.Caption = Format(bill, "Rp\. ###,###,###.-")
Change.Show
Case bill < 0
MsgBox "Not Enough Money", vbOKOnly, "Invalid"
Case Else
End Select
End If
End Sub
Related
How limit textbox input to numbers in the range from 1900 to current date?
Private Sub txtYear_Change()
If Not IsNumeric(txtYear.Text) Then
txtYear.Text = ""
ElseIf txtYear.Text < 1900 Or txtYear.Text > Year(Date) Then
txtYear.Text = ""
End If
Exit Sub
You need to place that code in your txtYear_Validate() event instead of the change event. Change will get triggered with each keystroke, so it will almost always immediately fail. Do not validate the entry until it's done, in the validate event.
As explained in Bill's answer, you should use the Validate event.
I just would like to add that your code still has a flaw, that is, it will allow users to enter decimal numbers (e.g., 1900.10). In order to avoid that, you can add another condition:
Private Sub txtYear_Validate(Cancel As Boolean)
If Not IsNumeric(txtYear.Text) Then
txtYear.Text = ""
ElseIf txtYear.Text < 1900 Or txtYear.Text > Year(Date) Then
txtYear.Text = ""
ElseIf Fix(txtYear.Text) <> txtYear.Text Then ' Choose one:
txtYear.Text = Fix(txtYear.Text) ' - Replace it with the integer part.
'txtYear.Text = "" ' - Clear the text.
End If
End Sub
Below code works great as expected the only downside is its slow because I am using this to search for all the instances of the substring and delete the Entire row if found in any cell of the whole workbook.
Aim is simple just delete the entirerow if the entered string is found in any cell string
Dim wo As Worksheet, ws As Worksheet
Dim I As Long, j As Long, m As Long
Dim toFind As String, testStr As String
Dim pos As Long
Dim lstRow As Long, cutRow As Long
Dim WS_Count As Integer
Dim Cell As Range
Option Compare Text
Option Explicit
Sub SearchDelete()
toFind = InputBox("Enter the substring you want to search for.", "Welcome", "AAAA")
toFind = Trim(toFind)
j = 0
If toFind = "" Then
MsgBox "Empty String Entered.Exiting Sub Now."
Exit Sub
Else
WS_Count = ActiveWorkbook.Worksheets.Count
'Begin the loop.
For I = 1 To WS_Count
Label1:
For Each Cell In Worksheets(I).UsedRange.Cells
If Trim(Cell.Text) <> "" Then
pos = 0
pos = InStr(1, Trim(Cell.Text), toFind, vbTextCompare)
If pos > 0 Then 'match Found'
cutRow = Cell.Row
Worksheets(I).Rows(cutRow).EntireRow.Delete
j = j + 1
GoTo Label1
Else: End If
Else: End If
Next Cell
Next I
End If
MsgBox "Total " & j & " Rows were deleted!"
End Sub
Individual operations are pretty much always slower than bulk operations and the Range.Delete method is no exception. Collecting the matching rows with a Union method and then performing the removal en masse will significantly speed up the operation.
Temporarily suspending certain application environment handlers will also help things along. You do not need Application.ScreenUpdating active while you are removing rows; only after you have completed the operation.
Option Explicit
Option Compare Text
Sub searchDelete()
Dim n As Long, w As Long
Dim toFind As String, addr As String
Dim fnd As Range, rng As Range
toFind = InputBox("Enter the substring you want to search for.", "Welcome", "AAAA")
toFind = Trim(toFind)
If Not CBool(Len(toFind)) Then
MsgBox "Empty String Entered.Exiting Sub Now."
GoTo bm_Safe_Exit
End If
'appTGGL bTGGL:=False 'uncomment this line when you have finsihed debugging
With ActiveWorkbook
For w = 1 To .Worksheets.Count
With .Worksheets(w)
Set fnd = .Cells.Find(what:=toFind, lookat:=xlPart, _
after:=.Cells.SpecialCells(xlCellTypeLastCell))
If Not fnd Is Nothing Then
Set rng = .Rows(fnd.Row)
n = n + 1
addr = fnd.Address
Do
If Intersect(fnd, rng) Is Nothing Then
n = n + 1
Set rng = Union(rng, .Rows(fnd.Row))
End If
Set fnd = .Cells.FindNext(after:=fnd)
Loop Until addr = fnd.Address
Debug.Print rng.Address(0, 0)
rng.Rows.EntireRow.Delete
End If
End With
Next w
End With
Debug.Print "Total " & n & " rows were deleted!"
bm_Safe_Exit:
appTGGL
End Sub
Public Sub appTGGL(Optional bTGGL As Boolean = True)
Application.ScreenUpdating = bTGGL
Application.EnableEvents = bTGGL
Application.DisplayAlerts = bTGGL
Application.Calculation = IIf(bTGGL, xlCalculationAutomatic, xlCalculationManual)
Debug.Print Timer
End Sub
The answer to your question: "How to speed up this code to find and delete rows if a substring is found" is - DON'T repeat the search from the top of the sheet after you found and removed the row!
Inserted my progress bar and it didn't work as expected. When i logged in, it works, but it doesn't automatically loads the second form.
Here is my code for progress/timer
Private Sub Timer1_Timer()
If ProgressBar1.Value = 100 Then
ProgressBar1.Value = 0
Else
ProgressBar1.Value = Val(ProgressBar1.Value) + Val(20)
End If
Label3.Caption = ProgressBar1.Value
Label , to detect 100, variable prg to hold
Private Sub Label3_Change()
If (Label3.Caption = 100) Then
prg = 1
Timer1.Interval = 0
End If
End Sub
log in button
Private Sub cmdSign_Click()
currentTime = TimeValue(Now)
strCurrdate = Format(Date, "mmm d, YYYY")
rx.Open "Select * from login where username ='" & Text1 & "' and password='" & Text2 & "'", db, 3, 3
If (counter = 3) And (rx.EOF = True) Then
MsgBox "You guessed too many times! Intruder alert!"
End
Else
If rx.EOF = True Then
MsgBox "Invalid Username or Password"
counter = counter + 1
Text1 = ""
Text2 = ""
Else
user1 = Text1.Text
logTime = currentTime
rxd.Open "Select * from logHistory", db, 3, 3
With rxd
.AddNew
.Fields("username") = user1
.Fields("TimeDate") = strCurrdate
.Fields("TimeIn") = logTime
.Update
End With
Set rxd = Nothing
'problem might be here
ProgressBar1.Visible = True
Timer1.Interval = 100
Label3.Visible = True
Timer1.Enabled = True
If prg = 1 Then
MsgBox "Welcome " + Text1 + " to SPARTAN!"
mainmenu.Show
End If
End If
End If
Set rx = Nothing
End Sub
Any help on this?
Once the timer is started it runs asynchronously to the rest of your code. The way you have coded your login button you are expecting the timer to move the progressbar from 0 to 100, set your (I assume) module scoped variable prg to 1 and then continue. In reality your code enables the timer and moves on. When it reaches the If prg = 1 Then statement prg is still whatever it has been initialized at. One way to fix it is to check the prg variable in your timer event.
Private Sub Timer1_Timer()
If ProgressBar1.Value = 100 Then
Timer1.Enabled = False ' don't fire the timer event again
ProgressBar1.Value = 0
MsgBox "Welcome " & Text1 & " to SPARTAN!"
mainmenu.Show
Else
ProgressBar1.Value = Val(ProgressBar1.Value) + Val(20)
End If
Label3.Caption = ProgressBar1.Value
End Sub
I also changed your string concatenation + to &. The plus symbol "+" works, but is only included in VB versions after 3 for backward compatibility and it is considered bad form to use it for other than arithmetic. In VB version 4 and greater the ampersand "&" should be used for concatenation. MSDN reference here
I am trying to validate the input of a TextBox to make sure it is a Binary Number. What I have so far is:
Private Sub Command1_Click()
Dim b() As Byte
b = Text1.Text
If Not IsByte (b) Then
Text3 = "Wrong input"
Else
Text3 = "CRC is generated"
' checksum.Text = Text1.Text Xor Text2.Text
' Trans(2).Text = (Text1.Text) + (checksum.Text)
End If
Input in Text1 should only be accepting binary numbers, so only 1 or 0 should be allowed.
You can use Like here:
Private Sub Command1_Click()
If Len(Text1.Text) = 0 Or Text1.Text Like "*[!0-1]*" Then
MsgBox "bad binary string"
Else
MsgBox "good binary string"
End If
End Sub
This pattern is testing for "0 to many of anything, followed by one character not in the range 0 through 1, then 0 to many of anything."
Below is the code. Request you to kindly google before posting any questions to this forum.
'will only allow 0 and 1
Private Sub Text1_KeyPress(KeyAscii As Integer)
Select Case KeyAscii
Case vbKey0 To vbKey1
Case Else
KeyAscii = 0
End Select
End Sub
' will validate if its numeric and you can further check for 0 or 1
Private Sub Command1_Click()
If Not IsNumeric(Text1.Text) Then
MsgBox "Please enter numbers only.", vbInformation
'you may also consider erasing it
Text1.Text = ""
End If
End Sub
Even i cant find the function to check binary data. But cant you just check like
If textbox1.text = 1 or textbox1.text = 2
I think you can also do with instr function.
I don't want to edit some of the column in flex gird.
Flex Grid
column1, column2, .... column35
i want to edit from column1... column10 only, remaining columns i don't want to edit or type.
How to do in vb6.
I believe the MS Flex Grid was designed for displaying data and not editing. If you need to edit cell data you can accomplish it using the Flex Grid using an approach of superimposing a textbox at runtime to capture user data entry and set the "Text" property of the cell in code. Otherwise you can choose to use a different control.
Here are some examples of the aforementioned approach:
http://support.microsoft.com/kb/241355
http://www.vb-helper.com/howto_edit_flexgrid_control.html
I've made a special user control in VB6 to an editable grid. If you want I can send you a copy.
The code I use to enable to edit a cell is the follow:
Private Sub fg_KeyDown(KeyCode As Integer, Shift As Integer)
Dim Cancel As Boolean
Dim Idc As Long
Dim x
If KeyCode = vbKeyEscape And Shift = 0 Then
If Not fgLocked Then
If fgRowChanged Then
RaiseEvent BeforeRestoreBuffer
For Idc = 1 To UBound(fgBuffer)
x = fgBuffer(Idc)
fgValues(Idc, fg.Row) = x
If fgColFormat(Idc) = "*" And fgBuffer(Idc) <> "" Then
fg.TextMatrix(fg.Row, Idc) = "*******"
ElseIf fgColFormat(Idc) = "RTF" Then
fg.TextMatrix(fg.Row, Idc) = Format(fgBuffer(Idc), "")
Else
fg.TextMatrix(fg.Row, Idc) = Format(fgBuffer(Idc), fgColFormat(Idc))
End If
Next
fgRowChanged = False
RaiseEvent RestoreBuffer
End If
End If
ElseIf KeyCode = vbKeyReturn And Shift = 0 Then
NextCell
ElseIf KeyCode = vbKeyF2 And Shift = 0 Then
If Not fgLocked Then
If fgColFormat(fg.Col) = "RTF" Then
CellEditBig fgValues(fg.Col, fg.Row)
Else
CellEdit fgValues(fg.Col, fg.Row)
End If
End If
ElseIf KeyCode = vbKeyF2 And Shift = vbShiftMask Then
If Not fgLocked Then
CellEditBig fgValues(fg.Col, fg.Row)
End If
ElseIf KeyCode = vbKeyDelete And Shift = 0 Then
If Not fgLocked Then
RaiseEvent BeforeDelete(Cancel)
If Not Cancel Then
If fg.Rows = fg.FixedRows + 1 Then
fg.AddItem ""
If fgRowNumber Then fg.TextMatrix(fg.Rows - 1, 0) = fg.Rows - 1
fgValues_AddItem ""
End If
fg.RemoveItem fg.Row
If fgRowNumber Then Renumera
fgValues_RemoveItem fg.Row
LoadBuffer fg.Row
RaiseEvent AfterDelete
End If
End If
ElseIf KeyCode = vbKeyInsert And Shift = 0 Then
If Not fgLocked Then
RaiseEvent BeforeInsert(Cancel)
If Not Cancel Then
fg.AddItem "", fg.Row
If fgRowNumber Then Renumera
fgValues_AddItem "", fg.Row
RaiseEvent AfterInsert
End If
End If
Else
RaiseEvent KeyDown(KeyCode, Shift)
End If
End Sub