I'm building a VB application that accepts numbers in the beginning. I want to be able to exit if the user presses the cancel button in any of the input boxes.
The code is :
Private Sub Command1_Click()
Dim a, b, c, d As Integer
Dim response As Integer
Dim a1, b1, c1, d1 As String
a = InputBox("Enter Numerator 1")
b = InputBox("Enter Denominator 1")
c = InputBox("Enter Numerator 2")
d = InputBox("Enter Denominator 2")
a1 = Str(a)
b1 = Str(b)
c1 = Str(c)
d1 = Str(d)
If a1 <> "" And b1 <> "" And c1 <> "" And d1 <> "" Then
'All Actions
...
Else
response = MsgBox("Are you sure you want to quit?", vbYesNo + vbQuestion, AdditionV1.0")
If response = vbYes Then
End
Else
Addition.Show
End If
I've tried using StrPtr and it stil doesnt work. What happens is even if I press Cancel, it still displays the error message.
Help will really be appreciated.
StrPtr is the way to go. Since you didn’t show the relevant code, there is no telling what you did wrong (but there are several errors in the code anyway). In principle, the following works:
Dim a As String
a = InputBox("Enter Numerator 1")
If StrPtr(a) = 0 Then
' Nothing was entered.
End If
I suspect that you applied the check to a1 etc. instead of the original variables. Not only does this not work (Str forces the string to be non-null), it also makes no sense: what are those variables for, anyway?
Furthermore, all your variable declarations are wrong. The following:
Dim a, b, c, d As Integer
declares a, b and c as Variant. Only d will be an Integer. For this, and for other reasons (readability), never declare multiple variables in one statement. Always declare them separately. Oh, and use meaningful names. a, b, c, d aren’t helpful.
If I understand your question correctly, you want to stop processing the moment user presses a cancel button.
I would suggest doing something like this (Note that I changed the variables to a1, b1,c1,d1 of assignment from InputBox):
Private Sub Command1_Click()
Dim a, b, c, d As Integer
Dim response As Integer
Dim a1, b1, c1, d1 As String
a1 = InputBox("Enter Numerator 1")
if (a1 = "")
exit sub
endif
b1 = InputBox("Enter Denominator 1")
if (b1 = "")
exit sub
endif
c1 = InputBox("Enter Numerator 2")
if (c1 = "")
exit sub
endif
d1 = InputBox("Enter Denominator 2")
if (d1 = "")
exit sub
endif
If a1 <> "" And b1 <> "" And c1 <> "" And d1 <> "" Then
'All Actions
...
Else
response = MsgBox("Are you sure you want to quit?", vbYesNo + vbQuestion, AdditionV1.0")
If response = vbYes Then
End
Else
Addition.Show
End If
Related
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!
In code [VB6], I'm searching in a collection for a specific data. Fam87 comes from a text file.
Function cumplefam(Fam87FO As String, rFamn1 As String, rFamn2 As String, rFam87 As String) As Boolean
Dim objfam As Tfamilias
Dim c1, c2, c3 As String
**objfam = getfamilia(Fam87FO)**
If rFamn1 = "" Then
c1 = "OK"
Else
If InStr(objfam.cFamn1, rFamn1) > 0 Then
c1 = "OK"
Else
c1 = "NO OK"
End If
End If
If rFamn2 = "" Then
c2 = "OK"
Else
If InStr(objfam.cFamn2, rFamn2) > 0 Then
c2 = "OK"
Else
c2 = "NO OK"
End If
End If
If rFam87 = "" Then
c3 = "OK"
Else
If InStr(objfam.cFam87, rFam87) > 0 Then
c3 = "OK"
Else
c3 = "NO OK"
End If
End If
If c1 = "OK" And c2 = "OK" And c3 = "OK" Then
cumplefam = True
Else
cumplefam = False
End If
End Function
The problem comes when getfamilia runs:
Function getfamilia(cFam As String) As Tfamilias
On Error Resume Next
Set getfamilia = Nothing
getfamilia = colfamilias(cFam)
End Function
Running it step-by-step does give me the data I want, but when it hits the End Function it shows:
Run-time error '91': Object variable or With block variable not set
I'm inexperienced in VB, so I don't really catch what my error is here.
Assuming that colfamilias has actually been initialized, for a return value that is an object, you must use Set:
Function getfamilia(cFam As String) As Tfamilias
On Error Resume Next
Set getfamilia = Nothing
Set getfamilia = colfamilias(cFam) '// change this line
End Function
And in your call to the function:
Set objfam = getfamilia(Fam87FO)
I have a2 richtext box first one called a1 second one b2 . Both of them have texts
What im trying to do is : delete any line that a2 has from b2
So if a2 contain lines
First line = 1256
Second one = 5678
....etc
I want to remove any line in b2 that contain this lines in a2 1256 and 5678 ..etc
I tried to use filter but that took long time because there are alot of lines and didnt work
I tried to solve your problem so i reached to this(it's not completely what you want but it may help you) :
Public Class Form1
Dim CheckChar, CheckedChar As String
Dim CheckedNum As Integer = 1
Private Sub CheckBUT_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CheckBUT.Click
If Not a1.Text = "" Then
If a1.Text.Length > 2 Then
ReRead: If CheckedNum = 1 Then
CheckChar = a1.Text.Remove(1)
Else
CheckChar = a1.Text.Substring(CheckedNum - 1)
If Not CheckedNum = a1.Text.Length Then
CheckChar = CheckChar.Remove(1)
End If
End If
If CheckChar.Contains("" & vbLf & "") Then
CheckedChar = a1.Text.Remove(CheckedNum - 1)
CheckChar = b2.Find(CheckedChar)
If Not CheckChar = -1 Then
b2.Text = b2.Text.Replace(CheckedChar & ("" & vbLf & ""), "")
End If
Else
a1.Text.Substring(CheckedNum - 1)
End If
If CheckedNum = a1.Text.Length Then
CheckedNum = 1
Else
CheckedNum = CheckedNum + 1
GoTo ReRead
End If
End If
End If
End Sub
End Class
I Hope The Code was Useful to You
I'm quite new to using VB, and I'm a beginner at programming, so I apologise for the poor/untidy code :P
I can't see what I'm doing wrong here. The program should get 3 numbers from the user, and those 3 numbers have to add up, then be divisible by 3 to be valid. Also, the number cannot be 1 less than the previous number. Failure to follow these 'rules' should result in a message box saying "INVALID SIDESWAP". I believe it is a problem with the MOD section, as no matter what I input, it always returns "VALID SIDESWAP". Any help will be greatly appreciated :)
Dim FirstNumber, SecondNumber, ThirdNumber As Integer
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
TextBox1.Text = FirstNumber
TextBox2.Text = SecondNumber
TextBox3.Text = ThirdNumber
If (FirstNumber + SecondNumber + ThirdNumber) Mod 3 = 0 Then
If (FirstNumber - SecondNumber) <> 1 And (SecondNumber - ThirdNumber) <> 1 And (ThirdNumber - FirstNumber) <> 1 Then
MsgBox("VALID SIDESWAP")
Else
MsgBox("INVALID SIDESWAP 1")
End If
Else
MsgBox("INVALID SIDESWAP 2")
End If
End Sub
What heirich said is true, and will fix the problem, as long as you do enter Numbers in the textbox.
If you want to avoid any error the quick way is:
Firstnumber = val(Textbox1.text)
etc.
You are using Integers for firstnumber, val will also recognize Decimals, so you can use cdbl as well.
Firstnumber = cdbl(Textbox1.text)
But Empty Textboxes will generate an error, so use a combination
Firstnumber = cdbl(val(Textbox1.text))
I have a little vb6 program:
Private Sub Form_Load()
Dim varTemp As Variant
Dim string1 As String
Dim x As Integer
x = 0
dialog.Filter = "toate fisierele(*.*) | *.*"
dialog.Flags = cdlOFNAllowMultiselect Or cdlOFNLongNames Or cdlOFNExplorer
'open the window to select files
dialog.ShowOpen
varTemp = Split(dialog.FileName, vbNullChar)
Do While (varTemp(x) <> "")
string1 = varTemp(x)
x = x + 1
Loop
Unload Form1
End
End Sub
I want the Do While to loop until it reaches the end of varTemp. However, when I choose two files from the dialog and "Do While" is hit with x = 3 I get "Run-time error '9': Subscript out of range". What condition should the "Do While" loop have to loop until the end of varTemp? Thank you.
You can use this instead:
Do While x <= UBound(varTemp)
Since varTemp will be an array, this will loop until you hit the last element in the array.
In case the user cancels the selection, and varTemp is empty, you may check for an empty string before looping, like this:
If varTemp <> vbNullString Then
Do While x <= UBound(varTemp)
string1 = varTemp(x)
x = x + 1
Loop
End If