Using Visual Basic in Excel

[Barnardos1]

Hey guys, I have a query based on visual basic coding in Excel. I am creating a user form for a piece of work, and there is a certain bit of the coding I am having an issue with. Here is my coding so far below:

Private Sub cmdAdd_Click()
'Copy input values to sheet.
Dim lRow As Long
Dim Row As Worksheet

If txtSupplierno.TextLength = 5 And IsNumeric(txtSupplierno.Value) Then


Set ws = Worksheets("Userform")
lRow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

With ws
.Cells(lRow, 1).Value = Me.txtName.Value
.Cells(lRow, 2).Value = Me.cboDepartment.Value
.Cells(lRow, 3).Value = Me.txtSupplierno.Value
.Cells(lRow, 4).Value = Me.txtEmployeeno.Value
.Cells(lRow, 5).Value = Me.txtDate.Value
.Cells(lRow, 6).Value = Me.cboCompany.Value
.Cells(lRow, 7).Value = Me.txtCostcentre.Value
.Cells(lRow, 8).Value = Me.txtAccount.Value
.Cells(lRow, 9).Value = Me.txtGroup.Value
.Cells(lRow, 10).Value = Me.txtClass.Value
.Cells(lRow, 11).Value = Me.txtProduct.Value
.Cells(lRow, 12).Value = Me.txtSpare.Value
.Cells(lRow, 13).Value = Me.txtAmntexclvat.Value
.Cells(lRow, 14).Value = Me.cbovatrate.Value
.Cells(lRow, 15).Value = Me.cboValid.Value

End With

Else

MsgBox "Enter a 5 digit supplier number!"
txtSupplierno.Value = ""

End If
End Sub

For my user form I am adding some fields which I would like to be mandatory so there needs to be coding to validate this. So far only my "txtSupplierno" is working but when I try to add my other fields using the If statement it doesn’t seem to work. I want it to work so that if someone enters a Cost Centre with less than 5 numbers, it will not still save. So far I have done it to work with Supplierno but I just need it to work for others with the If statement. If anyone knows how to solve this issue it would be very helpful. Thanks!

 

[bendipa]

What exactly are you trying to validate for each of these items? Some of them are alphanumeric or text and don't require to be used in calculations, unlike say a VAT rate which needs to be numeric or a date which should be in some date format. so how would you validate these text items?

 

[Barnardos1]

On Add_click for each entry I need to check the following:

• Supplier No needs to be populated with numbers of any length and is mandatory.
• Cost Centre needs to be populated with 5 digit numbers only and is mandatory.
• Account needs to be populated with 5 digit numbers only and is mandatory.
• Group, Class and Product needs to be populated by default with 00000; each field can be overwritten but only with 5 digit numbers. Each field is mandatory.
• Spare needs to be populated by default with 000 only, it is mandatory. The spare values shouldn’t be changed.
• Amount needs to be two decimal places and is mandatory
• VAT rate is 0 decimal places and is mandatory; this is a list of values so the values need to be limited to what is in the list.

 

[bendipa]

I'm still not sure what you mean in your 'Spare' validation as you seem to be saying you want a default value that can't be changed which doesn't make much sense to have on a form. Anyway I've written 3 procedures which covers most your requirements. You should be able to figure out the rest.

Private Sub TxtAccounts_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Dim num As Integer, mes As String
mes = "Please Enter 5 "
Call IsItNumeric(TxtAccounts.Text, num)
Select Case num
Case Is = -5
Exit Sub
Case Is = -1
MsgBox mes & "Digits"
Case Is = -2
MsgBox mes & "Digits"
Case Is = -3
MsgBox mes & "Digits"
Case Is = -4
MsgBox mes & "Digits"
Case Is = -6
MsgBox "You Have Entered a String" & Chr(13) & mes & "Digits"
Case Is = 0
MsgBox mes & "Digits"
End Select
TxtAccounts.Text = ""
Cancel = True
End Sub
Private Sub TxtVAT_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Dim num As Integer, mes As String
mes = "Please Enter 2 "
Call IsItNumeric(TxtVAT.Text, num)
Select Case num
Case Is = -2
TxtVAT.Text = Val(TxtVAT.Text)
Exit Sub
Case Is = -1
MsgBox mes & "Digits"
Case Is = -3
MsgBox mes & "Digits"
Case Is = -4
MsgBox mes & "Digits"
Case Is = -5
MsgBox mes & "Digits"
Case Is = -6
MsgBox "You Have Entered a String" & Chr(13) & mes & "Digits"
Case Is = 0
MsgBox mes & "Digits"
End Select
TxtVAT.Text = ""
Cancel = True
End Sub

Private Sub TxtSpares_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Dim num As Integer
TxtSpares.Text = "000"
End Sub

Sub IsItNumeric(teststr As String, number As Integer)
Dim x As Integer
x = 1
Do While Len(teststr) > 0 And IsNumeric(Mid(teststr, x, 1))
x = x + 1
Loop
Select Case True
Case IsNumeric(teststr) And Len(teststr) > 4 And Len(teststr) < 6
number = -5
Case IsNumeric(teststr) And Len(teststr) > 3 And Len(teststr) < 5
number = -4
Case IsNumeric(teststr) And Len(teststr) > 2 And Len(teststr) < 4
number = -3
Case IsNumeric(teststr) And Len(teststr) > 1 And Len(teststr) < 3
number = -2
Case IsNumeric(teststr) And Len(teststr) > 0 And Len(teststr) < 2
number = -1
Case x <= Len(teststr)
number = -6
End Select
End Sub

 

[bobgentry]

are these sheet cells that are being checked or textboxes on a form that are being checked?

if its textboxes (or other typeable control) there's a function called KeyPress that I've before used to put in a filter to block certain inputs.
and there's a way, using classes, to group those controls together so that a single KeyPress function can act as the filter for several textboxes at once (rather than having several identical KeyPress routines).

 

[bendipa]

are these sheet cells that are being checked or textboxes on a form that are being checked?

if its textboxes (or other typeable control) there's a function called KeyPress that I've before used to put in a filter to block certain inputs.
and there's a way, using classes, to group those controls together so that a single KeyPress function can act as the filter for several textboxes at once (rather than having several identical KeyPress routines).

They are textboxes being validated. That's what you asked for when you said you couldn't get them to work. I don't use keypress if I can help it as it causes me too many problems. I don't see how you can filter several boxes together unless they require identical validation parameters which doesn't apply in all the cases here. This doesn't take too long to write as you copy and paste the code for most of the boxes adjusting the switch codes (num) as you need for different validations. As long as it works properly that's all I care about. I've simplified/cleaned up the code a bit to post again so it's easier to read.
----------------------------------------------------------------------------------
Private Sub TxtAccounts_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Dim num As Integer, mes As String
mes = "Please Enter 5 "
Call IsItNumeric(TxtAccounts.Text, num)
Select Case num
Case Is = -5
Exit Sub
Case -1, -2, -3, -4, 0
MsgBox mes & "Digits", vbExclamation
Case -6
MsgBox "You Have Entered a String" & Chr(13) & mes & "Digits", vbExclamation
End Select
TxtAccounts.Text = ""
Cancel = True
End Sub

Private Sub TxtVAT_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Dim num As Integer, mes As String
mes = "Please Enter 2 "
Call IsItNumeric(TxtVAT.Text, num)
Select Case num
Case Is = -2
TxtVAT.Text = Val(TxtVAT.Text)
Exit Sub
Case -1, -3, -4, -5, 0
MsgBox mes & "Digits", vbExclamation
Case -6
MsgBox "You Have Entered a String" & Chr(13) & mes & "Digits", vbExclamation
End Select
TxtVAT.Text = ""
Cancel = True
End Sub

Private Sub TxtSpares_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Dim num As Integer
TxtSpares.Text = "000"
End Sub

Sub IsItNumeric(teststr As String, number As Integer)
Dim x As Integer
x = 1
Do While Len(teststr) > 0 And IsNumeric(Mid(teststr, x, 1))
x = x + 1
Loop
Select Case True
Case IsNumeric(teststr) And Len(teststr) > 4 And Len(teststr) < 6
number = -5
Case IsNumeric(teststr) And Len(teststr) > 3 And Len(teststr) < 5
number = -4
Case IsNumeric(teststr) And Len(teststr) > 2 And Len(teststr) < 4
number = -3
Case IsNumeric(teststr) And Len(teststr) > 1 And Len(teststr) < 3
number = -2
Case IsNumeric(teststr) And Len(teststr) > 0 And Len(teststr) < 2
number = -1
Case x <= Len(teststr)
number = -6
End Select
End Sub

 

[bobgentry]

(i wasnt the one asking that couldnt get them work :P, i was asking the op)

as for tying boxes together, i got a couple modules i wrote for myself that i stick in whereever i need them.
way it works is:
a) create a class module; i call it cControlGroup

b) inside the class module you put a line:

Public WithEvents tboxgroup As msforms.TextBox

, tboxgroup being the standin for the controls im trapping events for (in this case textboxes, but ive also done it for buttons, comboboxes, and so forth)

c)also inside, you put all the events you want to trap. for my key filter, i use keypress. i do this because it allows me to simply reject any keys i dont want allowed in the control, since keypress gives direct access to the ascii code of the key pressed, i simply change KeyAscii to null before returning it to the textbox, which results in nothing going in. quite useful

d) in main maodule/form/whatever, declare at module level

declare controlGroup as collection

e) in a subroutine of the form i use this code at initialize that samples through all the text boxes on my form, and adds them to the collection object. And because each individual object is a member of the class we created, we automatically take control over all their events at once, which trust me, for the number of control i need, is WAY EASIER that trying to do events for each one individually:

Private Sub InitControlGroup()

    If debugFlag Then Debug.Print "InitControlGroup"
    
    'variables
    Dim countBoxes As Variant
    Dim tempBox As cControlTorqueGroup
    
    Set tempBox = New cControlTorqueGroup
    
    'cycle through all the relevent text boxes
    For Each countBoxes In frm1.Controls

        'create empty temporary class item
        Set tempBox = New cControlTorqueGroup
        
        If TypeName(countBoxes) = "TextBox" Then
            
            'Assign temporary object to relevent class group
            Set tempBox.tboxgroup = countBoxes
            
            'Add to collection
            controlTorqueGroup.Add tempBox
        End If
    Next
    
End Sub

f) back in the class object i use this keypress function:

Private Sub tboxGroup_KeyPress(ByVal KeyAscii As msforms.ReturnInteger)

    If frmTorque.debugFlag Then Debug.Print "tboxGroup_KeyPress"

    KeyAscii = KeyFilter(KeyAscii, Me.tboxgroup, , True, , True)

End Sub

g) which calls this private function in the class which is the actual filter:

Optional allowUpper As Boolean, Optional allowLower As Boolean, Optional allowNum As Boolean, _
Optional allowDec As Boolean, Optional allowNeg As Boolean)

    If frmTorque.debugFlag Then Debug.Print "KeyFilter"

    If allowAll Then
        KeyFilter = KeyAscii
        Exit Function
    End If
    
    With obj
        Select Case KeyAscii
        
            'Do nothing if its a letter...
            Case Asc("A") To Asc("Z")
                '...if uppercase are allowed...
                If allowUpper Then
                ElseIf allowLower Then
                    KeyAscii = Asc(LCase(Chr(KeyAscii)))
                Else
                    KeyAscii = 0
                End If
            
            Case Asc("a") To Asc("z")
                '...or lowercase are allowed...
                If allowLower Then
                ElseIf allowUpper Then
                    KeyAscii = Asc(UCase(Chr(KeyAscii)))
                Else
                    KeyAscii = 0
                End If
            
            'Do nothing if its a number...
            Case Asc("0") To Asc("9")
                '...if numbers are allowed
                If allowNum Then
                Else
                    KeyAscii = 0
                End If
            
            'Allow only 1 negative sign...
            Case Asc("-")
                '...if negatives are allowed
                If allowNeg Then
                    If InStr(1, .Text, "-") > 0 Or .SelStart > 0 Then
                        KeyAscii = 0
                    End If
                Else
                    KeyAscii = 0
                End If
            
            'Allow only one decimal point...
            Case Asc(".")
                '...if decimals are allowed
                If allowDec Then
                    If InStr(1, .Text, ".") > 0 Then
                        KeyAscii = 0
                    End If
                Else
                    KeyAscii = 0
                End If
                
            'Disallow all other entries
            Case Else
                KeyAscii = 0
        End Select
    End With
    KeyFilter = KeyAscii
        
End Function

Though to be totally honest, its been a bit (7 years?) since i made the code, and i dont remember if i actually need the collection object for it to work.
But i do also manipulate the group of controls all at once, and the collection is useful for that. as i said, i made it a bit ago, and find it very useful for my needs, especially if doing list or combo boxes, which introduce even more events i want/need to handle. if something actually needs a seperate handle, i typically handle it inside the event sub by querying which control is the one knocking on the door (simple 'IF me.tboxgroup.name="" then')

 

[bobgentry]

as for doing several identical routines, like say a class module just chock full of simple get/let's, i have a special module i run that simply creates them for me. just feed it an array of whatever bit needs to change each time, and boom (have to toggle off the 'prevent VBA to edit VBA' thing temporarily; just dont forget to re-enable it). real time saver.

 

[bobgentry]

and noticed the first line of my keyfilter function got cut off somehow, and there doesnt seem to be an edit button.
it should reads 'Private Function KeyFilter(KeyAscii As Variant, obj As Variant, Optional allowAll As Boolean, _'

 

[bendipa]

Yeah, many thnx for all that. I have to admit I don't understand class modules although I'm aware of them. So reading through your code, to be honest is just making me scratch my head at the moment, as I have not much of a clue what you are doing. I'm sure there are many different ways of doing the same thing. And once I find a way that works for me without causing endless frustration I tend to stick with it. However when I find the time and motivation I will have a look at class modules in more detail to see whether I can make head or tail of it.