Using MOD and nesting - vb6

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))

Related

Visual Basic 2010 For ..To Statment

Public Class Form1
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim password As String, ch As Char
Dim i As Integer
Dim valid As Boolean = False
While valid = False
password = InputBox("Please enter your password")
For i = 0 To password.Length - 1
ch = password.Chars(i)
If Not Char.IsLetterOrDigit(ch) Then
valid = True
Exit For
End If
Next
If valid Then
MsgBox("Your new password will be activated immediately")
Else
MsgBox("your password must contain at least one special symbol")
End If
End While
End Sub
Hello all, this program will check if there is a symbol within the password ,my question is in the statment (For i = 0 To password.Length - 1) its about (-1) why did we write -1,i understood everything except this -1 , thanks
Right i got it , you are right . Its because vb starts counting from 0 , so if i write 1234 this mean for vb 12345 and then we should remove the last digit by -1 and then we beocome 1234 as result. Thank you Hans Passant

Improve Looping Efficiency in VBA

I have a For loop that loops through integers 1 to 9 and simply finds the bottom most entry that corresponds to that integer ( i.e. 1,1,1,2,3,4,5 would find the 3rd "1" entry) and inserts a blank row. I concatenate the number with a string "FN" that just corresponds to the application for this code, just to clarify. Anyway, it works well, but it lags quite a bit for only having to run through 9 integers. I was hoping someone would be able to help me debug to improve speed on this code. Thanks!
Bonus points if anyone can shed some light on a good way to populate the blank row being inserted with a formatted copy of the header of the page that spans ("A1:L1"). The code I attempted is commented out right before Next i.
Sub test()
Dim i As Integer, Line As String, Cards As Range
Dim Head As Range, LR2 As Long
For i = 1 To 9
Line = "FN" & CStr(i)
Set Cards = Sheets(1).Cells.Find(Line, after:=Cells(1, 1), searchdirection:=xlPrevious)
Cards.Rows.Offset(1).EntireRow.Insert
Cards.Offset(1).EntireRow.Select
' Range("A" & (ActiveCell.Row), "K" & (ActiveCell.Row)) = Range("A3:K3")
' Range("A" & (ActiveCell.Row), "K" & (ActiveCell.Row)).Font.Background = Range("A3:K3").Font.Background
Next i
End Sub
This works pretty fast for me
Sub Sample()
Dim i As Long, line As String, Cards As Range
With Sheets(1)
For i = 1 To 9
line = "FN" & i
Set Cards = .Columns(6).Find(line, LookIn:=xlValues, lookat:=xlWhole)
If Not Cards Is Nothing Then
.Range("A3:K3").Copy
Cards.Offset(1, -5).Insert Shift:=xlDown
End If
Next i
End With
End Sub
Before
After
Most of your improvements will come from altering the application environment variables with the appTGGL helper function but there are a few tweaks in the base code here.
Option Explicit
Sub ewrety()
Dim f As Long, fn0 As String, fndfn As Range
'appTGGL btggl:=false 'uncomment this when you are confident in it
With Worksheets(1).Columns("F")
For f = 1 To 9
fn0 = Format$(f, "\F\N0")
Set fndfn = .Find(What:=fn0, After:=.Cells(1), LookIn:=xlFormulas, LookAt:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False)
With fndfn
.Offset(1, -5).EntireRow.Insert Shift:=xlDown
.Parent.Range("A1:L1, XFC1").Copy Destination:=.Offset(1, -5)
End With
Next f
End With
appTGGL
End Sub
Public Sub appTGGL(Optional bTGGL As Boolean = True)
With Application
.ScreenUpdating = bTGGL
.EnableEvents = bTGGL
.DisplayAlerts = bTGGL
.AutoRecover.Enabled = bTGGL 'no interruptions with an auto-save
.Calculation = IIf(bTGGL, xlCalculationAutomatic, xlCalculationManual)
.CutCopyMode = False
.StatusBar = vbNullString
End With
Debug.Print Timer
End Sub

Creating a userform that prints textbox input to specific spots in the document

I was working on a system in VBA word. The goal of the system is to replace several different words in a document with input from a text box. So far I have a userform with 12 different text boxes each containing input from a user to replace words in the document. I made a button in the userform to print all the input from the textboxes to the document.
For each textbox I made the following code:
Sub FindAndReplaceAllStoriesHopefully()
Dim myStoryRange As Range
'
'
'Loop replaces everything with <KLANTNAAM> in the document
For Each myStoryRange In ActiveDocument.StoryRanges
With myStoryRange.Find
.Text = "<KLANTNAAM>"
.Replacement.Text = TextBox1.Value
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With
Do While Not (myStoryRange.NextStoryRange Is Nothing)
Set myStoryRange = myStoryRange.NextStoryRange
With myStoryRange.Find
.Text = "<KLANTNAAM>"
.Replacement.Text = TextBox1.Value
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With
Loop
Next myStoryRange
So far I did this for all 12 textboxes and it works but it isn't smooth. The
button upon getting clicked is calling the function with
Call FindAndReplaceAllStoriesHopefully
I have a few problems which I just cannot fix:
Once the button is clicked and some textboxes are not filled by the user, the marked words like <KLANTNAAM> are still replaced and removed from the document.
The performance of the macro is not great since the same code is copied 12 times.
Once the button is clicked, there is no easy way for the user to undo mistakes typed in the userform since the results are already printed.
I was hoping to get some tips so I can finalize this application.
Something like this:
Private Sub CommandButton1_Click()
Dim numBlank As Long, n As Long, txt As String
Dim bookMarkName As String
numBlank = Me.CountBlanks
If numBlank > 0 Then
If MsgBox(numBlank & " entries are blank!. Continue?", _
vbExclamation + vbOKCancel) <> vbOK Then
Exit Sub
End If
End If
For n = 1 To 4
txt = Me.Controls("Textbox" & n).Text
bookMarkName = "BOOKMARK" & n
FindAndReplaceAllStoriesHopefully bookMarkName, txt
Next n
End Sub
Function CountBlanks() As Long
Dim n As Long, b As Long
b = 0
For n = 1 To 4
If Len(Me.Controls("Textbox" & n).Text) = 0 Then
b = b + 1
End If
Next n
CountBlanks = n
End Function

VB Validate TextBox input to be Binary Number

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.

How to reduce the decimal length

I want to reduce the decimal length
text1.text = 2137.2198231578
From the above, i want to show only first 2 digit decimal number
Expected Output
text1.text = 2137.21
How to do this.
Format("2137.2198231578", "####.##")
I was about to post use Format() when I noticed p0rter comment.
Format(text1.text, "000.00")
I guess Int() will round down for you.
Been many years since I used VB6...
This function should do what you want (inline comments should explain what is happening):
Private Function FormatDecimals(ByVal Number As Double, ByVal DecimalPlaces As Integer) As String
Dim NumberString As String
Dim DecimalLocation As Integer
Dim i As Integer
Dim LeftHandSide As String
Dim RightHandSide As String
'convert the number to a string
NumberString = CStr(Number)
'find the decimal point
DecimalLocation = InStr(1, NumberString, ".")
'check to see if the decimal point was found
If DecimalLocation = 0 Then
'return the number if no decimal places required
If DecimalPlaces = 0 Then
FormatDecimals = NumberString
Exit Function
End If
'not a floating point number so add on the required number of zeros
NumberString = NumberString & "."
For i = 0 To DecimalPlaces
NumberString = NumberString & "0"
Next
FormatDecimals = NumberString
Exit Function
Else
'decimal point found
'split out the string based on the location of the decimal point
LeftHandSide = Mid(NumberString, 1, DecimalLocation - 1)
RightHandSide = Mid(NumberString, DecimalLocation + 1)
'if we don't want any decimal places just return the left hand side
If DecimalPlaces = 0 Then
FormatDecimals = LeftHandSide
Exit Function
End If
'make sure the right hand side if the required length
Do Until Len(RightHandSide) >= DecimalPlaces
RightHandSide = RightHandSide & "0"
Loop
'strip off any extra didgits that we dont want
RightHandSide = Left(RightHandSide, DecimalPlaces)
'return the new value
FormatDecimals = LeftHandSide & "." & RightHandSide
Exit Function
End If
End Function
Usage:
Debug.Print FormatDecimals(2137.2198231578, 2) 'outputs 2137.21
Looks fairly simple, but I must be missing something subtle here. What about:
Option Explicit
Private Function Fmt2Places(ByVal Value As Double) As String
Fmt2Places = Format$(Fix(Value * 100#) / 100#, "0.00")
End Function
Private Sub Form_Load()
Text1.Text = Fmt2Places(2137.2198231578)
End Sub
This also works in locales where the decimal point character is a comma.

Resources