Conditional statements on CheckBox & TextBox in Userforms (VBA) - excel

I am new to coding UserForms in VBA and require a bit of assistance with coding a conditional statement on a certain number of pairs of CheckBoxs and TextBoxs.
Clearly a loop will be involved, but I just cant seem to incorporate it. Here is one of the methods I have tried and failed with:
For i = 1 To 12
If CheckBox(i).Value = True And TextBox(i) = "" Or CheckBox(i).Value = False And TextBox(i).Value <> "" Then
MsgBox ("Warning")
End If
Next i
Thank you for any help!!!!!!
Regards

In a UserForm are not CheckBox or TextBox collections. Thats why CheckBox(index) or TextBox(index) will not work.
But there is a Controls collection.
For i = 1 To 12
'If CheckBox(i).Value = True And TextBox(i) = "" Or CheckBox(i).Value = False And TextBox(i).Value <> "" Then
If Me.Controls("CheckBox" & i).Value = True And Me.Controls("TextBox" & i).Value = "" _
Or Me.Controls("CheckBox" & i).Value = False And Me.Controls("TextBox" & i).Value <> "" Then
MsgBox ("Warning")
End If
Next
Assuming all CheckBoxes have corresponding TextBoxes with same numbers, CeckBox1 - TextBox1, CeckBox2 - TextBox2, ... then:
Dim oControl As Control
Dim sTextBoxName As String
For Each oControl In Me.Controls
If LCase(TypeName(oControl)) = "checkbox" Then
sTextBoxName = Replace(oControl.Name, "checkbox", "textbox", , , vbTextCompare)
If oControl.Value = (Me.Controls(sTextBoxName).Value = "") Then
MsgBox "Warning " & Me.Controls(sTextBoxName).Name & ", " & oControl.Name
End If
End If
Next

Related

Userform Data entry "Update" setting wrong values when editing an entry

So I've got a userform for entering and looking up customer information, Everythign seems to currently work, except for the "Update" Button. When utilizing the update button, its changing my city and state values to my zipcode value, aswell as adjusting whatever else was changed. City and state should not be changing to my zipcode value. city and state values are populated utilizing a vlookup within a zipcodedata tab.
Below is the code for my update button:
Private Sub UpdateButton_Click()
If Me.CustID.Value = "" Then
MsgBox "Select customer record to update!"
Exit Sub
End If
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Customer Database")
Dim Selected_Row As Long
Selected_Row = Application.WorksheetFunction.Match(CLng(Me.CustID.Value), ThisWorkbook.Worksheets("Customer Database").Range("A:A"), 0)
'Validations-----------------------------------------------------
If Me.CustomerName.Value = "" Then
MsgBox "Plese enter the customers name!", vbCritical
Exit Sub
End If
'-------
If Me.CustomerBusiness.Value = "" Then
MsgBox "Plese enter the customers business!", vbCritical
Exit Sub
End If
'-------
If Me.CustomerAddress.Value = "" Then
MsgBox "Plese enter the customers address!", vbCritical
Exit Sub
End If
'-------
If Me.CustomerPhone.Value = "" Then
MsgBox "Plese enter the customers phone number!", vbCritical
Exit Sub
End If
'----------------------------------------------------------------
sh.Range("B" & Selected_Row).Value = Me.CustomerName.Value
sh.Range("C" & Selected_Row).Value = Me.CustomerBusiness.Value
sh.Range("D" & Selected_Row).Value = Me.CustomerAddress.Value
sh.Range("E" & Selected_Row).Value = Me.City.Value
sh.Range("F" & Selected_Row).Value = Me.State.Value
sh.Range("G" & Selected_Row).Value = Me.Zipcode.Value
sh.Range("H" & Selected_Row).Value = Me.CustomerPhone.Value
sh.Range("I" & Selected_Row).Value = Me.CustomerEmail.Value
sh.Range("J" & Selected_Row).Value = Me.MachineSerial1.Value
sh.Range("K" & Selected_Row).Value = Me.MachineSerial2.Value
sh.Range("L" & Selected_Row).Value = Me.MachineSerial3.Value
'----------------------------------------------------------------
Me.CustomerName.Value = ""
Me.LCaseName.Value = ""
Me.CustomerBusiness.Value = ""
Me.CustomerAddress.Value = ""
Me.Zipcode.Value = ""
Me.City.Value = ""
Me.State.Value = ""
Me.CustomerPhone.Value = ""
Me.CustomerEmail.Value = ""
Me.MachineSerial1.Value = ""
Me.MachineSerial2.Value = ""
Me.MachineSerial3.Value = ""
Me.CustID.Value = ""
'----------------------------------------------------------------
Call Refresh
End Sub
Here is the code for populating the City and State text boxes:
Private Sub Zipcode_Change()
Dim rng As Range
Dim a As Integer
On Error Resume Next
a = 0
Set rng = Worksheets("ZipCodeData").Range("ZipCodes")
Lastrow = Worksheets("ZipCodeData").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To Lastrow
If Me.Zipcode = Worksheets("ZipCodeData").Cells(i, 1).Value Then
a = a + 1
End If
Next
If a >= 1 Then
Me.City.Value = Application.WorksheetFunction.VLookup(Zipcode.Value, rng, 2, 0)
Me.State.Value = Application.WorksheetFunction.VLookup(Zipcode.Value, rng, 3, 0)
End If
If a = 0 Then
Me.City.Value = ""
Me.State.Value = ""
End If
End Sub
I've tried commenting out my "Zipcode_Change" sub, as I thought perhaps it was having issues interpreting the vlookup values when utilizing the update feature. I have a "add" button (which is identical to the update button, except the Selected_Row is a Last_Row. The "Add" button functions and works as intended, so I recopied my "Add" button code and readjusted it for the update button, and the issue persists.

Excel VBA script - stealing focus

I'm working on a script that pings computers from a list periodically and returns information.
My problem is, whenever the the script is running, it steals focus from other excel windows.
For example if if I'm typing in another workbook when the scrip runs, it jumps (to the cell that was last selected) and continues writing in the cell.
Here is the script:
Sub autoping_cb()
Dim c As Range
Dim thePing As Variant
Dim TryCount As Integer
Dim TryAgainCount As Integer
Dim TryNextRun As Boolean
TryNextRun = False
Set sht = Application.ThisWorkbook.Worksheets(1)
LastRow = sht.Cells(sht.Rows.Count, "B").End(xlUp).Row
Dim chb As Shape
Set chb = ThisWorkbook.Worksheets(1).Shapes("autoping")
If chb.ControlFormat.Value = xlOn Then
sht.Range("H3").Value = Replace(sht.Range("H3").Value, ",", ".")
TryCount = 1
If sht.Range("H4") <> "" And IsNumeric(sht.Range("H4")) = True And sht.Range("H4") = Int(sht.Range("H4")) And sht.Range("H3") <> "" And IsNumeric(sht.Range("H3")) = True Then
TryAgainCount = sht.Range("H4").Value
If TryAgainCount = 0 Then
TryNextRun = True
End If
Do Until chb.ControlFormat.Value = xlOff
Wait ThisWorkbook.Worksheets(1).Range("H3").Value * 60 '<-- replace to 60 after testing
For Each c In Application.Worksheets(1).Range("B3:B" & LastRow)
If chb.ControlFormat.Value = xlOff Then
End
ElseIf chb.ControlFormat.Value = xlOn Then
If ispcname(c.Value) = True Or isip(c.Value) = True Then
If c.Offset(0, 2) = "--->" And TryNextRun = False Then
Else
c.Offset(0, 1) = nslookup(c.Value)
thePing = sPing(c.Value)
c.Offset(0, 2) = thePing(0)
c.Offset(0, 3) = GetErrorCode(thePing(1))
If c.Offset(0, 2).Value = "--->" Then
sht.Range("B" & c.Row & ":E" & c.Row).Style = "Bad"
ElseIf c.Offset(0, 2).Value < 50 Then
sht.Range("B" & c.Row & ":E" & c.Row).Style = "Good"
Else
sht.Range("B" & c.Row & ":E" & c.Row).Style = "Neutral"
End If
End If
End If
End If
sht.Range("B2:E" & LastRow + 1).Columns.AutoFit
Next c
If TryNextRun = False And TryCount < TryAgainCount Then
TryCount = TryCount + 1
Debug.Print 1
ElseIf TryNextRun = False And TryCount >= TryAgainCount Then
TryNextRun = True
TryCount = 1
Debug.Print 2
ElseIf TryNextRun = True And TryAgainCount <> 0 Then
TryNextRun = False
Debug.Print 3
End If
Loop
Else
MsgBox "invalid 'Ping every'/'try offline after' integer"
End If
End If
End Sub
It's a bit messy I know :-)
Beacuse all excel sheets are running on one thread (one Excel.exe instance, you can see one presence in task manager).
If you are running more excel instance, your sheet are working independently.
You can do one of these possibilities :
-simple open new Excel.exe from start menu, icon, etc
-windows tray excel icon right click then alt+click on Microsoft Excel
-start command (or shortcut or batch file): Excel.exe "xls path" /x
-vba
Sub OpenNewExcelInstance()
Dim xlApp As Excel.Application
Set xlApp = New Excel.Application
xlApp.Workbooks.Add
xlApp.Visible = True
Set xlApp = Nothing
End Sub
-modify your registry to force open in new instance
-modify your Personal.xlsb
i think the easiest solution is to use the task -scheduler, and start your macro from there. In the extend properties choose "run whether user is logged on or not", then this is started in a separate task.

VBA Userform Listbox Conditional Logic Not Working as Intended

I have a Userform with a listbox for which I am using conditional logic to determine output values to the sheet of selected or non-selected items in the listbox. The issue is that when the Textbox (Tbl_AliasName) is blank, the code executes this:
ElseIf .Selected(k) = True And Tbl_AliasName = vbNullString Then
lstbxRow = lstbxRow + 1
Worksheets("New TRAX").Cells(lstbxRow, 3) = Trim(Cells(2, 1).Value2) & "." & .Column(1, k)
But if Tbl_AliasName is not blank then the code does nothing, but it is supposed to do this:
ElseIf .Selected(k) = True And Tbl_AliasName <> vbNullString Then
lstbxRow = lstbxRow + 1
Worksheets("New TRAX").Cells(lstbxRow, 3) = Tbl_AliasName & "." & .Column(1, k)
I have used several variations of If statements, and non of which have worked.
Below is My Code:
Option Explicit
Public Tbl_AliasName As String
Tbl_AliasName = Trim(UserForm_Finder.txtConcat.Value)
Private Sub BtnConcat_Click()
Dim k As Long, lstbxRow As Long, LR As Long
lstbxRow = 1
'****************
'This if statement works perfectly
If (Cells(2, 1).Value2 = vbNullString Or Cells(2, 2).Value2 = vbNullString) _
And Tbl_AliasName = vbNullString Then
MsgBox "You must Search for a Table or Column first.", _
vbExclamation, "Error Encountered"
Exit Sub
ElseIf (UserForm_Finder.ListBx_TblsCols.ListCount = 0 And Tbl_AliasName <> vbNullString) Then
MsgBox "You must Search for a Table or Column first.", _
vbExclamation, "Error Encountered"
'(Cells(2, 1).Value2 = vbNullString Or Cells(2, 2).Value2 = vbNullString) And _
Exit Sub
End If
With UserForm_Finder.ListBx_TblsCols
For k = 0 To .ListCount - 1
'****************
This is where the problems begin
If .Selected(k) = False Then
MsgBox "You must Select 1 or more items from the list box.", _
vbExclamation, "Error Encountered"
Exit Sub
ElseIf .Selected(k) = True And Tbl_AliasName <> vbNullString Then
lstbxRow = lstbxRow + 1
Worksheets("New TRAX").Cells(lstbxRow, 3) = Tbl_AliasName & "." & .Column(1, k)
ElseIf .Selected(k) = True And Tbl_AliasName = vbNullString Then
lstbxRow = lstbxRow + 1
Worksheets("New TRAX").Cells(lstbxRow, 3) = Trim(Cells(2, 1).Value2) & "." & .Column(1, k)
End If
Next k
End With
End Sub
My goal is to do the following:
If a Textbox (Tbl_AliasName) is not blank and the user has selected one or more items in the listbox (ListBx_TbleCols) then concatenate the Tbl_AliasName to the selected items in the listbox
If Tbl_AliasName is blank, then use the value in Cells(2,1) to concatenate to the selected Items in the list box.
I have tried the following additions:
Dim LstBxItemSelected As Boolean
'This was placed in the for loop
LstBxItemSelected = True
'this was placed outside the for loop
If LstBxItemSelected = False Then
MsgBox "You must Select 1 or more items from the list box.", _
vbExclamation, "Error Encountered"
Exit Sub
End If
Is there a better way to tell if items are selected, because I feel that the way I have it structured in my loop, the code will throw the error if everything isn't selected? Thank you in advance for any ideas, answers, or suggestions!
Note: The Listbox is populated by the click of another button on the userform which calls the following sub:
Sub FillLstBxCols()
Dim ListBx_Target As MSForms.ListBox
Dim rngSource As Range
Dim LR As Long
If Cells(2, 1).Value2 <> vbNullString Then
LR = Worksheets("New TRAX").Cells(Rows.Count, 2).End(xlUp).Row
'Set reference to the range of data to be filled
Set rngSource = Worksheets("New Trax").Range("A" & 2 & ":" & "B" & LR)
'Fill the listbox
Set ListBx_Target = UserForm_Finder.ListBx_TblsCols
With ListBx_Target
.RowSource = rngSource.Address
End With
End If
End Sub
Hard to say without sample data and expected results, but I think this is what you're looking for:
Private Sub btnConcat_Click()
Dim ws As Worksheet
Dim bSelected As Boolean
Dim sConcat As String
Dim i As Long, lRowIndex As Long
Set ws = ActiveWorkbook.Sheets("New TRAX")
lRowIndex = 1
bSelected = False
sConcat = Trim(Me.txtConcat.Text)
If Len(sConcat) = 0 Then sConcat = Trim(ws.Cells(2, "A").Value)
If Len(sConcat) = 0 Then
MsgBox "You must Search for a Table or Column first.", vbExclamation, "Error Encountered"
Exit Sub
End If
For i = 0 To Me.ListBx_TblsCols.ListCount - 1
If Me.ListBx_TblsCols.Selected(i) Then
If bSelected = False Then
bSelected = True
ws.Range("C2", ws.Cells(ws.Rows.Count, "C")).Clear 'clear previous concat results (delete this line if not needed)
End If
lRowIndex = lRowIndex + 1
ws.Cells(lRowIndex, "C").Value = sConcat & "." & Me.ListBx_TblsCols.List(i)
End If
Next i
If bSelected = False Then MsgBox "Must select at least one item from the list"
End Sub

If condition in for loop

Sub NewRefesh()
If Not Range("X2") = "COMPLETE" Or Range("X2") = "CANCELLED" Then
Range("X2").Select
ActiveCell.FormulaR1C1 = "=GetOrderStatus(RC[1])"
End If
End Sub
The above code does for only X2 but i want do it till X52.
(Ex: Next check in X3 = COMPLETE" Or Range("X3") = "CANCELLED" Then
Range("X3").Select
ActiveCell.FormulaR1C1 = "=GetOrderStatus(RC[1])"and do the action, next X4 and so on
I think in your post you meant your criteria to be :
Not Range("X2") = "COMPLETE" >> can be replaced also with Range("X2") <> "COMPLETE"
Not Range("X2") = "CANCELLED" >> can be replaced also with Range("X2") <> "CANCELLED"
Note: it's better to stay away from Select and ActiveCell, instead use referenced Ranges. In your code you code directly use Range("X" & i).FormulaR1C1
Code
Option Explicit
Sub NewRefesh()
Dim i As Long
' simple For loop, you can modify to find last row with data instead of 52
For i = 2 To 52
If (Not Range("X" & i).Value = "COMPLETE") And (Not Range("X" & i).Value = "CANCELLED") Then
Range("X" & i).FormulaR1C1 = "=GetOrderStatus(RC[1])"
End If
Next i
End Sub
use row/col numbering
x is Column number 24
for i = 2 to 52
If Not cells(i,24) = "COMPLETE" Or cells(i,24) = "CANCELLED" Then
Range(i,24).Select
Whatever you want done.........
End If
Next i

VBA code Using Data table to populate the userform

So I am doing some coding for the payroll application. When I run the macro and enter EmployeeNumber in textbox1, I get sent to debugging and third row of code "c=application.worksheet...." is highlighted in yellow. Basically, when I enter employee number in textbox 1, the subsequent information of that employee should get populated by itself. Can someone please tell me what I am doing wrong in the code below?
Private Sub CommandButton1_Click()
Me.TextBox2.Enabled = True
Me.TextBox3.Enabled = True
Me.TextBox4.Enabled = True
Me.TextBox5.Enabled = True
Me.TextBox6.Enabled = True
Me.CommandButton2.Visible = True
Me.CommandButton1.Visible = False
End Sub
Private Sub CommandButton2_Click()
m = MsgBox("Do You Want To Update Employee Information?", vbQuestion + vbYesNo, "Confirm Update")
If m = vbNo Then Exit Sub
EmployeeNumber = Val(Me.TextBox1.Value)
c = Application.WorksheetFunction.CountIf(MasterData.Range("A:A"), EmployeeNumber)
If c = 0 Then Exit Sub
r = Application.WorksheetFunction.Match(EmployeeNumber, MasterData.Range("A:A"), 0)
MasterData.Range("B" & r).Value = Me.TextBox2.Value
MasterData.Range("C" & r).Value = Me.TextBox3.Value
MasterData.Range("D" & r).Value = Me.TextBox4.Value
MasterData.Range("E" & r).Value = Me.TextBox5.Value
MasterData.Range("F" & r).Value = Me.TextBox6.Value
Me.TextBox2.Enabled = False
Me.TextBox3.Enabled = False
Me.TextBox4.Enabled = False
Me.TextBox5.Enabled = False
Me.TextBox6.Enabled = False
Me.CommandButton2.Visible = False
Me.CommandButton1.Visible = True
End Sub
Private Sub CommandButton3_Click()
Unload.Me
End Sub
Private Sub Label1_Click()
End Sub
Private Sub Label2_Click()
End Sub
Private Sub Label5_Click()
End Sub
Private Sub TextBox1_Change()
Dim wks As Worksheet
Set wks = Worksheets("MasterData")
EmployeeNumber = Val(Me.TextBox1.Value)
c = Application.WorksheetFunction.CountIf(MasterData.Range("A:A"), EmployeeNumber)
If c = 0 Then
Me.TextBox2.Value = ""
Me.TextBox3.Value = ""
Me.TextBox4.Value = ""
Me.TextBox5.Value = ""
Me.TextBox6.Value = ""
Exit Sub
End If
r = Application.WorksheetFunction.Match(EmployeeNumber, MasterData.Range("A:A"), 0)
Me.TextBox2.Value = MasterData.Range("B" & r).Value
Me.TextBox3.Value = MasterData.Range("C" & r).Value
Me.TextBox4.Value = MasterData.Range("D" & r).Value
Me.TextBox5.Value = MasterData.Range("E" & r).Value
Me.TextBox6.Value = MasterData.Range("F" & r).Value
End Sub
Private Sub UserForm_Click()
End Sub
This must not compile - fix that first:
Syntax error in
r = Application.worksheerfunction.Match
Fixed:
r = Application.WorksheetFunction.Match
EDIT: Fix more syntax errors
Replace MasaterData with MasterData
MasaterData.Range("B" & r).Value = Me.TextBox2.Value
MasaterData.Range("C" & r).Value = Me.TextBox3.Value
MasaterData.Range("D" & r).Value = Me.TextBox4.Value
MasaterData.Range("E" & r).Value = Me.TextBox5.Value
MasaterData.Range("F" & r).Value = Me.TextBox6.Value
You can do simple troubleshooting yourself to find the problem by simplifying your code to get one item to work - then expanding the code that works.
The simplest way to troubleshoot VBA problems yourself is to add MSGBOX or DEBUG.PRINT statements to your code to trace what's happening
Currently the issue you have is that you have two locations that handle your text box - the one that's causing you a problem right now is in TextBox_Change - that's going to fire once for every character you type in.
You either want to remove that completely or move it to the TextBox AfterUpdate event - and then decide if you want to remove the duplicate code in the Command Click event
Well Apparently, the userform wasn't enabled "True/False" from properties. That was the reason, I couldn't type anything in textbox 1. I'd like to thanks DbMitch for teaching me the step by step debug approach. The form does its intended function now.

Resources