I am new to VBA and my problem might be stupid, but I cant fix it, so please help me if you can!
Here is the thing: I got userform that fills spreadsheet perfectly, but if information is not entered it does crazy things. As you may see below i found some piece of code to check if the data is entered, so if its not window pops up and you have to enter something, but when you do form fills 2 rows of data instead of one. For example, if pick row 'x' and want to put values 'a','b','c','d', but forgot to put value 'c' then it shows an error and when i type missing value 'c' and press OK it creates row 'x' with values 'a','b',' ','d' and row 'x+1' with values 'a','b','c','d'.
Here is my code:
Private Sub cmdok_Click()
'next empty cell in column A
Set c = Range("a65536").End(xlUp).Offset(1, 0)
Application.ScreenUpdating = False 'speed up, hide task
'write userform entries to database
c.Value = Me.txtFname.Value
c.Offset(0, 3).Value = Me.txtngoals.Value
c.Offset(0, 28).Value = Me.cmbDiag.Value
If Me.optAcute.Value = "True" And Me.optchronic.Value = "False" Then
c.Offset(0, 29).Value = 1
c.Offset(0, 30).Value = ""
Else
c.Offset(0, 29).Value = ""
c.Offset(0, 30).Value = 1
End If
'input validation
If txtFname.Value = "" Then
MsgBox ("Sorry, you need to provide a Name")
txtFname.SetFocus
Exit Sub
End If
If txtngoals.Value = "" Then
MsgBox ("Sorry, you need to provide goals")
txtngoals.SetFocus
Exit Sub
End If
If cmbDiag.Value = "" Then
MsgBox ("Sorry, you need to provide Diagnosis")
cmbDiag.SetFocus
Exit Sub
End If
If optAcute.Value = optchronic.Value Then
MsgBox ("Sorry, you need to select Time since injury")
Exit Sub
End If
'clear the form
With Me
.txtFname.Value = vbNullString
.cmbDiag.Value = vbNullString
.optAcute.Value = vbNullString
.optchronic.Value = vbNullString
.txtngoals.Value = vbNullString
End With
Application.ScreenUpdating = True
End Sub
thank you in advance
Try moving the code "write userform entries to database" to after the validation checks.
Private Sub cmdok_Click()
'next empty cell in column A
Set c = Range("a65536").End(xlUp).Offset(1, 0)
Application.ScreenUpdating = False 'speed up, hide task
'input validation
If txtFname.Value = "" Then
MsgBox ("Sorry, you need to provide a Name")
txtFname.SetFocus
Exit Sub
End If
If txtngoals.Value = "" Then
MsgBox ("Sorry, you need to provide goals")
txtngoals.SetFocus
Exit Sub
End If
If cmbDiag.Value = "" Then
MsgBox ("Sorry, you need to provide Diagnosis")
cmbDiag.SetFocus
Exit Sub
End If
If optAcute.Value = optchronic.Value Then
MsgBox ("Sorry, you need to select Time since injury")
Exit Sub
End If
'write userform entries to database
c.Value = Me.txtFname.Value
c.Offset(0, 3).Value = Me.txtngoals.Value
c.Offset(0, 28).Value = Me.cmbDiag.Value
If Me.optAcute.Value = "True" And Me.optchronic.Value = "False" Then
c.Offset(0, 29).Value = 1
c.Offset(0, 30).Value = ""
Else
c.Offset(0, 29).Value = ""
c.Offset(0, 30).Value = 1
End If
'clear the form
With Me
.txtFname.Value = vbNullString
.cmbDiag.Value = vbNullString
.optAcute.Value = vbNullString
.optchronic.Value = vbNullString
.txtngoals.Value = vbNullString
End With
Application.ScreenUpdating = True
Related
I'm having a problem with access-VS it's ways Variable not defined can anyone help me?
This is the code that i'm working on: (am a newbie)
Option Compare Database
Option Explicit
Private Sub btnLogin_Click()
Dim rs As Recordset
Set rs = CurrentDb.OpenRecordset("tbl1Employees", dbOpenSnapshot, dbReadOnly)
rs.FindFirst "UserName='" & Me.txtUserNAme & "'"
If rs.NoMatch = True Then
Me.lblWrongUser.Visible = True
Me.txtUserNAme.SetFocus
Exit Sub
End If
Me.lblWrongUser.Visible = False
If rs!Password <> Nz(Me.txtPassword, "") Then
Me.lblWrongPass.Visible = True
Me.txtPassword.SetFocus
Exit Sub
End If
Me.lblWrongPass.Visible = False
DoCmd.OpenForm "frmMenu"
DoCmd.Close acForm, Me.Name
End Sub
I am new with vb6 and communication app, I try to run a example that transmitting and receiving data between two serial ports ( I install two serial ports by com0com soft).
In this example, I want User to type charracters in textbox1, then click command button, and charracters in textbox1 display in textbox2.
Private Sub Command1_Click()
com1.Output = Text1.Text
End Sub
Private Sub Form_Load()
com1.CommPort = 1
com1.Settings = "9600,n,8,1"
com1.PortOpen = True
com2.CommPort = 2
com2.Settings = "9600,n,8,1"
com2.PortOpen = True
Text1.Text = ""
Text2.Text = ""
End Sub
Private Sub com2_OnComm()
If com2.CommEvent = comEvReceive Then
Text2.Text = Text2.Text + com2.Input
End If
End Sub
I screened form in the example and setting in com0com port, I don't have enought reputation to post image, so I upload this to flickr.
http://farm8.staticflickr.com/7627/16740707238_6b1d9ec3ab_b.jpg
But when I try to run this example by type charracters in textbox1 and click button, nothing happen.
So what am I doing wrong?. If so, how can I do to get data from com1 port to com2port? Or any advice for anything!
thanks for reading !
I think you need to look a little harder at the documentation.
Here's a minimal example where COM3/COM4 are the looped ports on my machine:
Option Explicit
Private Sub Command1_Click()
If Len(Text1.Text) > 0 Then
MSComm1.Output = Text1.Text
Text1.Text = vbNullString
End If
Text1.SetFocus
End Sub
Private Sub Form_Load()
With MSComm1
.CommPort = 3
.Settings = "256000,n,8,1"
.Handshaking = comNone
.SThreshold = 0 'No events after send completions.
.RThreshold = 0 'No events after receive completions.
.PortOpen = True
End With
With MSComm2
.CommPort = 4
.Settings = "256000,n,8,1"
.EOFEnable = False
.Handshaking = comNone
.InputMode = comInputModeText
.RThreshold = 1 'Event for each character received. Terribly
'inefficient but if char-by-char events are
'required there isn't much choice.
.SThreshold = 0 'No events after send completions.
.PortOpen = True
End With
End Sub
Private Sub Form_Unload(Cancel As Integer)
MSComm1.PortOpen = False
MSComm2.PortOpen = False
End Sub
Private Sub MSComm2_OnComm()
With MSComm2
If .CommEvent = comEvReceive Then
.InputLen = 0
Text2.SelStart = &H7FFF
Text2.SelText = .Input
End If
End With
End Sub
Hi Hi I have to write a code where if the user clicks enters something in the input box it should proceed further.If it doesnot enter any value it should throw back the same question again again.This i have already achieved,but my problem is when user click on CANCEl it agains asks the same question whereas it ishould exit .I am very new to VB Script .Plz help me how to handle these buttons?Below is my existing code
Do while x=0
strAnswer = InputBox("Please enter the file extension * For all files:", _
"File Extension")
If strAnswer = "" Then
MsgBox"You must enter an extension."
Else
a=strAnswer
Exit Do
End If
Loop
intRow = 2
'strFileName = "T:\public\Madhumita\New.xls"
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
Set objWorkbook = objExcel.Workbooks.Add()
'objWorkbook.SaveAs(strFileName)
objExcel.Cells(1, 1).Value = "Folder"
objExcel.Cells(1, 2).Value = "File Name"
objStartFolder = "T:\public\Madhumita\Madhu"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(objStartFolder)
Set colFiles = objFolder.Files
If a="*" Then
For Each objFile in colFiles
objExcel.Cells(intRow, 1).Value = objfolder.Name
objExcel.Cells(intRow, 2).Value = objFile.Name
intRow = intRow + 1
Next
else
For Each objFile in colFiles
m=objFSO.GetExtensionName( objFile.Path )
If m=a Then
objExcel.Cells(intRow, 1).Value = objfolder.Name
objExcel.Cells(intRow, 2).Value = objFile.Name
intRow = intRow + 1
End If
Next
End If
objExcel.Range("A1:B1").Select
objExcel.Selection.Font.Bold = True
objExcel.Cells.EntireColumn.AutoFit
Sub SaveAs()
Application.Dialogs(xlDialogSaveAs).Show
End Sub
objExcel.Quit
MsgBox "Done"
You need to deal with (at least) three cases - InputBox() returns:
an empty value (Empty, vbEmpty) because the user pressed Cancel or closed the dialog
an empty string ("") or a string of blanks (" ")
a (hopefully) valid string
In code:
Option Explicit
Do While True
Dim vInp : vInp = InputBox("ee")
WScript.Echo TypeName(vInp)
Select Case True
Case IsEmpty(vInp)
WScript.Echo "Abort"
Exit Do
Case "" = Trim(vInp)
WScript.Echo "Try again"
Case Else
WScript.Echo "Work with " & vInp
Exit Do
End Select
Loop
sample output:
String
Try again
Empty
Abort
String
Work with aaa
Sorry to say, but the Docs just lie:
If the user clicks OK or presses ENTER, the InputBox function returns
whatever is in the text box. If the user clicks Cancel, the function
returns a zero-length string ("").
It should be:
... If the user clicks Cancel, the function returns an empty value
(TypeName Empty, VarType vbEmpty).
For InputBox(), you can use the default value to determine if the user clicked Cancel or if they clicked OK or hit Enter to continue without entering a value:
Sub Get_TIN()
TIN = Trim(InputBox("Enter the provider TIN:", "Provider TIN", "ex. 123456789"))
If TIN = "" Then 'When CANCEL is clicked because "TIN" will be empty.
MsgBox "You pressed Cancel. Program will now end.", vbExclamation + vbOKOnly, "Macro End"
Exit Sub
End If
If IsEmpty(TIN) = False Then 'When OK is clicked or Enter pressed because default text will be stored. Next, set TIN to "".
TIN = ""
End If
End Sub
I'm using VBS and my investigation into cancel/ok revealed the following:
Cancel returns an empty string AND a zero length string - same thing you say?, apparently not.
Ok returns a zero length string only.
I use the code below to differentiate.
if IsEmpty(nmbr) then 'cancel button pressed ?
nmbr = "x"
end if
if not IsEmpty(nmbr) then 'ok button pressed ?
if len(nmbr) = 0 then
nmbr = "ok"
end if
end if
I'm new to vb and trying to figure things out via searching the net or asking colleagues but now I hit a dead end. I want to have my program to make sure that all my textboxes are filled before saving into the db.
Here is my code:
Private Sub CmdSave_Click()
Set rs = New ADODB.Recordset
With rs
.Open "Select * from table1", cn, 2, 3
If LblAdd_Edit.Caption = "ADD" Then
If MsgBox("Do you want to save this new rocord?", vbQuestion + vbYesNo, "FJD Inventory") = vbNo Then: Exit Sub
.AddNew
!Type = TxtName.Text
!System = txtsys.Text
!acc = TxtAcc.Text
!owner = TxtOwn.Text
!dept = TxtDpt.Text
!svctag = txtSvcTag.Text
.Update
Else
If MsgBox("Do you want to save this changes?", vbQuestion + vbYesNo, "FJD Inventory") = vbNo Then: Exit Sub
Do While Not .EOF
If LvList.SelectedItem.Text = !Type Then
!Type = TxtName.Text
!System = txtsys.Text
!acc = TxtAcc.Text
!owner = TxtOwn.Text
!dept = TxtDpt.Text
!svctag = txtSvcTag.Text
.Update
Exit Do
Else
.MoveNext
End If
Loop
End If
End With
Form_Activate
Save_Cancel
End Sub
I was trying to add the following
If TxtName.Text = "" Or txtsys.Text = "" Or TxtAcc.Text = "" Or TxtOwn.Text = "" Or TxtDpt.Text = "" Or txtSvcTag.Text = "" Then
MsgBox("All Fields Required", vbCritical, "Error") = vbOK: Exit Sub
When I run the program I get a compile error
function or call on the left-hand side of assignment must return a variant or object. I use that msgbox function all the time but now its the line I get an error
If TxtName.Text = "" Or txtsys.Text = "" Or TxtAcc.Text = "" Or TxtOwn.Text = "" Or TxtDpt.Text = "" Or txtSvcTag.Text = "" Then
If MsgBox("All Fields Required", vbCritical, "Error") = vbOK Then Exit Sub
Here is a generic solution. It uses a function to check each textbox on the form and demonstrates using the function. I also compare the text length rather than the text to an empty string because (in general) numeric comparisons are faster than string comparisons.
Private Sub Command1_Click()
If ValidateTextFields Then
MsgBox "Your changes have been saved."
Else
MsgBox "All fields are required."
End If
End Sub
Private Function ValidateTextFields() As Boolean
Dim ctrl As Control
Dim result As Boolean
result = True 'set this to false if a textbox fails
For Each ctrl In Me.Controls
If TypeOf ctrl Is TextBox Then
If Len(ctrl.Text) = 0 Then
result = False
Exit For 'bail on the first failure
End If
End If
Next ctrl
ValidateTextFields = result
End Function
In VB6, you can use Trim() function so that spaces not considered as characters.
If (Trim$(txtGOSID.Text) = "") Then
msgBox "Please provide input.", vbExclamation
With the $ sign, Trim() returns a String value directly; without the $
sign, Trim() returns a Variant with a sub-type of String.
I have two .vbs file say a.vbs and b.vbs.Now both are written for the same Excel,but would work on 2 different sheets.So can we run those in parallel?
EDIT
a.vbs will update sheet2 and b.vbs will update sheet3.But for both source sheet is sheet1.
Please advice how to set such environment
CODE A
Option Explicit
Dim objExcel1
Dim strPathExcel1
Dim objSheet1,objSheet2
Dim IntRow1,IntRow2
Dim ColStart
Set objExcel1 = CreateObject("Excel.Application")'Object for Condition Dump
strPathExcel1 = "D:\AravoVB\Copy of Original Scripts\CopyofGEWingtoWing_latest_dump_21112012.xls"
objExcel1.Workbooks.open strPathExcel1
Set objSheet1 = objExcel1.ActiveWorkbook.Worksheets(1)
Set objSheet2 = objExcel1.ActiveWorkbook.Worksheets("Bad Data")
objExcel1.ScreenUpdating = False
objExcel1.Calculation = -4135 'xlCalculationManual
IntRow2=2
IntRow1=4
Do Until IntRow1 > objSheet1.UsedRange.Rows.Count
ColStart = objExcel1.Application.WorksheetFunction.Match("Parent Business Process ID", objSheet1.Rows(3), 0) + 1
Do Until ColStart > objSheet1.UsedRange.Columns.Count And objSheet1.Cells(IntRow1,ColStart) = ""
If objSheet1.Cells(IntRow1,ColStart + 1) > objSheet1.Cells(IntRow1,ColStart + 5) And objSheet1.Cells(IntRow1,ColStart + 5) <> "" Then
objSheet1.Range(objSheet1.Cells(IntRow1,1),objSheet1.Cells(IntRow1,objSheet1.UsedRange.Columns.Count)).Copy
objSheet2.Range(objSheet2.Cells(IntRow2,1),objSheet2.Cells(IntRow2,objSheet1.UsedRange.Columns.Count)).PasteSpecial
IntRow2=IntRow2+1
Exit Do
End If
ColStart=ColStart+4
Loop
IntRow1=IntRow1+1
Loop
objExcel1.ScreenUpdating = True
objExcel1.Calculation = -4105 'xlCalculationAutomatic
CODE B
Option Explicit
Dim objExcel1
Dim strPathExcel1
Dim objSheet1,objSheet2
Dim IntRow1,IntRow2
Dim Flag
Dim IntColTemp,IntRowTemp
Dim Strcmp1,Strcmp2
Flag=0
IntColTemp=1
IntRowTemp=3
Set objExcel1 = CreateObject("Excel.Application")'Object for Condition Dump
If Err.Number <> 0 Then
On Error GoTo 0
Wscript.Echo "Excel application not found."
Wscript.Quit
End If
strPathExcel1 = "D:\VA\CopyofGEWingtoWing_latest_dump_21112012.xls"
objExcel1.Workbooks.open strPathExcel1
Set objSheet1 = objExcel1.ActiveWorkbook.Worksheets(1)
Set objSheet2 = objExcel1.ActiveWorkbook.Worksheets(2)
IntRow1=4
IntRow2=1
Do While objSheet1.Cells(IntRow1, 1).Value <> ""
objSheet2.Cells(IntRow2, 1).Value = objSheet1.Cells(IntRow1, 1).Value
IntColTemp=1
Flag=0
'This will travarse to the Parent Business Process ID column horizantally in the excel.
Do While Flag=0
If objSheet1.Cells(IntRowTemp,IntColTemp).Value="Parent Business Process ID" Then
Flag=1
End If
IntColTemp=IntColTemp+1
Loop
IntColTemp=IntColTemp-1
'MsgBox(IntColTemp)
Strcmp1=trim(objSheet1.Cells(IntRow1, 1).Value)
Strcmp2=trim(objSheet1.Cells(IntRow1,IntColTemp).Value)
If Strcmp1=Strcmp2 Then
objSheet2.Cells(IntRow2, 2).Value="Parent"
Else
objSheet2.Cells(IntRow2, 2).Value="child"
End If
IntRow1=IntRow1+1
IntRow2=IntRow2+1
Loop
Working on two different sheets should be possible by putting something like this in both of your scripts:
strPathExcel1 = "D:\CopyofGEWingtoWing_latest_dump_21112012.xls"
On Error Resume Next
Set objExcel1 = GetObject(, "Excel.Application") ' attach to running instance
If Err.Number = 429 Then ' if that fails
Err.Clear
Set objExcel1 = CreateObject("Excel.Application") ' create new instance
If Err Then ' if that still fails
WScript.Echo Err.Description & " (0x" & Hex(Err.Number) & ")"
WScript.Quit 1 ' report error and terminate
End If
objExcel1.Workbooks.Open strPathExcel1
End If
On Error Goto 0
However, I doubt that this approach would gain you enough performance to justify the additional complexity.
In CODE A replace the lines
Set objExcel1 = CreateObject("Excel.Application")'Object for Condition Dump
strPathExcel1 = "D:\AravoVB\Copy of Original Scripts\CopyofGEWingtoWing_latest_dump_21112012.xls"
objExcel1.Workbooks.open strPathExcel1
with the above code block.
In CODE B replace the lines
Set objExcel1 = CreateObject("Excel.Application")'Object for Condition Dump
If Err.Number <> 0 Then
On Error GoTo 0
Wscript.Echo "Excel application not found."
Wscript.Quit
End If
strPathExcel1 = "D:\VA\CopyofGEWingtoWing_latest_dump_21112012.xls"
objExcel1.Workbooks.open strPathExcel1
with the above code block.