Form Creation and Programming

marcusja2002

Board Regular
Joined
Apr 27, 2010
Messages
107
All

I was able to find a good functional VBA code to place form data into a database(almost completed just need to add defects). See below.

What I want to be able to do is instead of having a column for each of my defect families and types, I want a way to have the program review what is checked and input a new row for every defect type that is checked. If there is a single defect it will be entered once when I run the submit code, if there are multiple checks, it will add a new row with all the txtbox data and the defect family and type.


Private Sub cmbsubmit_Click()
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("DynoRepairData")


iRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1


If Trim(Me.txtjo.Value) = "" Then
Me.txtjo.SetFocus
MsgBox "Please enter a Job Number"
Exit Sub
End If


With ws
.Cells(iRow, 1).Value = Me.txtjo.Value
.Cells(iRow, 2).Value = Me.txtdte.Value
.Cells(iRow, 3).Value = Me.txtmdl.Value
.Cells(iRow, 4).Value = Me.txtsrl.Value
.Cells(iRow, 5).Value = Me.txttchn.Value
.Cells(iRow, 6).Value = Me.txtep.Value
.Cells(iRow, 7).Value = Me.txthtvlt.Value
.Cells(iRow, 8).Value = Me.txtwt.Value
End With


'clear the data
Me.txtjo.Value = ""
Me.txtdte.Value = ""
Me.txtmdl.Value = ""
Me.txtsrl.Value = ""
Me.txttchn.Value = ""
Me.txtep.Value = ""
Me.txthtvlt.Value = ""
Me.txtwt.Value = ""
Me.txtjo.SetFocus
End Sub

Thank you in advance.
 
Re: Check box how to change true / false to other possibilities

If the object is to get a certain value in Range("A1")
Why use 20 checkboxes?

Why not use one listbox or Combobox to select the value from and then that value would be entered into "A1"
 
Last edited:
Upvote 0

Excel Facts

What is the shortcut key for Format Selection?
Ctrl+1 (the number one) will open the Format dialog for whatever is selected.
Re: Check box how to change true / false to other possibilities

The reason for this is the programming logic. If there are multiple choices I need a new line of data input for each defect. There is a group of text boxes that would need to be placed in the spread sheet in preset columns and then the defect would land in a defect column.

Can a list box or combo box allow for multiple selections or only one?
 
Upvote 0
Re: Check box how to change true / false to other possibilities

Yes you can choose more the one value in a listbox or combobox if it's set up to allow that.

But if I understand you correct if you click on a checkbox named "Blue" you want "Blue" entered into range ("A1")

So you would never be clicking on more the one Checkbox at a time so why would you need to choose more then one item in a listbox

I have not been able to get the checkbox name when you click on it so I have not come up with a answer for you

Maybe someone else can explain how to get the name of a ActiveX checkbox when you click on it. I tried Application.Caller but that does not work.

Name not Caption
 
Last edited:
Upvote 0
Re: Check box how to change true / false to other possibilities

I figured out one way to get what I want. It places the word I want in the cell then allows for aloop back to read another cell if its also checked. It may not be pretty but it works

Private Sub cmbsubmit_Click()
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("DynoRepairData")


'find first empty row in database
Start: iRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1


'check for a part number
If Trim(Me.txtjo.Value) = "" Then
Me.txtjo.SetFocus
MsgBox "Please enter a Job Number"
Exit Sub
End If


'copy the data to the database
'use protect and unprotect lines,
' with your password
' if worksheet is protected
With ws
' .Unprotect Password:="password"
.Cells(iRow, 1).Value = Me.txtjo.Value
.Cells(iRow, 2).Value = Me.txtdte.Value
.Cells(iRow, 3).Value = Me.txtmdl.Value
.Cells(iRow, 4).Value = Me.txtsrl.Value
.Cells(iRow, 5).Value = Me.txttchn.Value
.Cells(iRow, 6).Value = Me.txtep.Value
.Cells(iRow, 7).Value = Me.txthtvlt.Value
.Cells(iRow, 8).Value = Me.txtwt.Value
.Cells(iRow, 13).Value = Me.txtRprcmnt.Value
.Cells(iRow, 14).Value = Me.OptionButtondynoyes.Value
.Cells(iRow, 15).Value = Me.txtdynotechinitials.Value
.Cells(iRow, 16).Value = Me.txtleadmaninitials.Value

' this next bit will either verify a box
' isnt checked and move on to the next or add information to database
If Me.Checkfuel.Value = False Then
Else
.Cells(iRow, 9).Value = "Leaks"
.Cells(iRow, 10).Value = "Fuel"
.Cells(iRow, 11).Value = Me.txtfueltime.Value
Me.Checkfuel.Value = False
Me.txtfueltime.Value = ""
GoTo Start
End If
If Me.CheckOil.Value = False Then
Else
.Cells(iRow, 9).Value = "Leaks"
.Cells(iRow, 10).Value = "Oil"
.Cells(iRow, 11).Value = Me.txtoiltime.Value
Me.CheckOil.Value = False
Me.txtoiltime.Value = ""
GoTo Start
End If
.Cells(iRow, 1).Value = ""
.Cells(iRow, 2).Value = ""
.Cells(iRow, 3).Value = ""
.Cells(iRow, 4).Value = ""
.Cells(iRow, 5).Value = ""
.Cells(iRow, 6).Value = ""
.Cells(iRow, 7).Value = ""
.Cells(iRow, 8).Value = ""
.Cells(iRow, 13).Value = ""
.Cells(iRow, 14).Value = ""
.Cells(iRow, 15).Value = ""
.Cells(iRow, 16).Value = ""
' .Protect Password:="password"
End With
Me.txtjo.SetFocus
End Sub
 
Upvote 0
Re: Check box how to change true / false to other possibilities

marcusja2002: As per Mr Excel's Rule 12 (http://www.mrexcel.com/forum/board-announcements/99490-forum-rules.html) kindly don't make duplicate posts about the same issue. I have merged the two threads. There may be some overlaps in the discussion as a result, but you'll have to live with that; at least now people won't be working at cross-purposes.
 
Upvote 0
Re: Check box how to change true / false to other possibilities

Macropod. Sorry about that. I thought they were two separtate issues needed for one problem. I'll make sure to not do that again.
 
Upvote 0
Re: Check box how to change true / false to other possibilities

I now have a finished (albet non-efficent code). I now need some help utilizing the data I input into excel to create a secondary form. THis form will look down the Leadman column (column 16) for the first blank cell. It will then populate the form with all of the data I just input so the leadman can review, documenet a root cause and fix, etc. in new columns 17 through 21 then sign off in column 16. Thank you in advance for your help



Private Sub cmbsubmit_Click()
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("DynoRepairData")


'find first empty row in database
Start: iRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1


'check for a part number
If Trim(Me.txtjo.Value) = "" Then
Me.txtjo.SetFocus
MsgBox "Please enter a Job Number"
Exit Sub
End If


'copy the data to the database use protect and unprotect lines,
' with your password if worksheet is protected
With ws
' .Unprotect Password:="password"
.Cells(iRow, 1).Value = Me.txtjo.Value
.Cells(iRow, 2).Value = Me.txtdte.Value
.Cells(iRow, 3).Value = Me.txtmdl.Value
.Cells(iRow, 4).Value = Me.txtsrl.Value
.Cells(iRow, 5).Value = Me.txttchn.Value
.Cells(iRow, 6).Value = Me.txtep.Value
.Cells(iRow, 7).Value = Me.txthtvlt.Value
.Cells(iRow, 8).Value = Me.txtwt.Value
.Cells(iRow, 13).Value = Me.txtRprcmnt.Value
If OptionButtondynoyes = True Then .Cells(iRow, 14).Value = "Yes"
If OptionButtondynono = True Then .Cells(iRow, 14).Value = "No"
.Cells(iRow, 15).Value = Me.txtdynotechinitials.Value

' this next bit will either verify a box isnt checked and move on to the next or add information to database
If Me.Checkfuel.Value = False Then
Else
.Cells(iRow, 9).Value = "Leaks"
.Cells(iRow, 10).Value = "Fuel"
.Cells(iRow, 11).Value = Me.txtfueltime.Value
Me.Checkfuel.Value = False
Me.txtfueltime.Value = ""
GoTo Start
End If
If Me.CheckOil.Value = False Then
Else
.Cells(iRow, 9).Value = "Leaks"
.Cells(iRow, 10).Value = "Oil"
.Cells(iRow, 11).Value = Me.txtoiltime.Value
Me.CheckOil.Value = False
Me.txtoiltime.Value = ""
GoTo Start
End If
If Me.CheckCoolant.Value = False Then
Else
.Cells(iRow, 9).Value = "Leaks"
.Cells(iRow, 10).Value = "Coolant"
.Cells(iRow, 11).Value = Me.txtcooltime.Value
Me.CheckCoolant.Value = False
Me.txtcooltime.Value = ""
GoTo Start
End If
If Me.CheckCoolloopwtr.Value = False Then
Else
.Cells(iRow, 9).Value = "Leaks"
.Cells(iRow, 10).Value = "Cooling Loop Water"
.Cells(iRow, 11).Value = Me.txtcoolloopwattime.Value
Me.CheckCoolloopwtr.Value = False
Me.txtcoolloopwattime.Value = ""
GoTo Start
End If
If Me.CheckPowerview.Value = False Then
Else
.Cells(iRow, 9).Value = "Panel Issue"
.Cells(iRow, 10).Value = "Powerview"
.Cells(iRow, 11).Value = Me.txtpwrvwtime.Value
Me.CheckPowerview.Value = False
Me.txtpwrvwtime.Value = ""
GoTo Start
End If
If Me.CheckPMCI.Value = False Then
Else
.Cells(iRow, 9).Value = "Panel Issue"
.Cells(iRow, 10).Value = "PMCI"
.Cells(iRow, 11).Value = Me.txtPMCItime.Value
Me.CheckPMCI.Value = False
Me.txtPMCItime.Value = ""
GoTo Start
End If
If Me.CheckWireHarness.Value = False Then
Else
.Cells(iRow, 9).Value = "Wiring Harness"
.Cells(iRow, 10).Value = "Wiring Harness"
.Cells(iRow, 11).Value = Me.txtwrhrnstime.Value
Me.CheckWireHarness.Value = False
Me.txtwrhrnstime.Value = ""
GoTo Start
End If
If Me.CheckTach.Value = False Then
Else
.Cells(iRow, 9).Value = "Tachometer"
.Cells(iRow, 10).Value = "Tachometer"
.Cells(iRow, 11).Value = Me.txttachtime.Value
Me.CheckTach.Value = False
Me.txttachtime.Value = ""
GoTo Start
End If
If Me.CheckMECAB.Value = False Then
Else
.Cells(iRow, 9).Value = "MECAB issue"
.Cells(iRow, 10).Value = "MECAB issue"
.Cells(iRow, 11).Value = Me.txtMECABtime.Value
If OptionButtonYes = True Then .Cells(iRow, 12).Value = "Yes"
If OptionButtonNo = True Then .Cells(iRow, 12).Value = "No"
Me.CheckMECAB.Value = False
Me.txtMECABtime.Value = ""
GoTo Start
End If
If Me.CheckHE.Value = False Then
Else
.Cells(iRow, 9).Value = "Heat Exchanger Issue"
.Cells(iRow, 10).Value = "Heat Exchanger Issue"
.Cells(iRow, 11).Value = Me.txtHEtime.Value
Me.CheckHE.Value = False
Me.txtHEtime.Value = ""
GoTo Start
End If
If Me.CheckLeaking.Value = False Then
Else
.Cells(iRow, 9).Value = "Leaking"
.Cells(iRow, 10).Value = "Leaking"
.Cells(iRow, 11).Value = Me.txtlktime.Value
Me.CheckLeaking.Value = False
Me.txtlktime.Value = ""
GoTo Start
End If
If Me.CheckFuelSetGovSet.Value = False Then
Else
.Cells(iRow, 9).Value = "Fuel Setting / Governor Spring"
.Cells(iRow, 10).Value = "Fuel Setting / Governor Spring"
.Cells(iRow, 11).Value = Me.txtfsgstime.Value
Me.CheckFuelSetGovSet.Value = False
Me.txtfsgstime.Value = ""
GoTo Start
End If
If Me.CheckMagPick.Value = False Then
Else
.Cells(iRow, 9).Value = "Mag Pickup"
.Cells(iRow, 10).Value = "Mag Pickup"
.Cells(iRow, 11).Value = Me.txtmagpktime.Value
Me.CheckMagPick.Value = False
Me.txtmagpktime.Value = ""
GoTo Start
End If
If Me.CheckOilGauge.Value = False Then
Else
.Cells(iRow, 9).Value = "Oil Gauge"
.Cells(iRow, 10).Value = "Oil Gauge"
.Cells(iRow, 11).Value = Me.txtoilgagetime.Value
Me.CheckOilGauge.Value = False
Me.txtoilgagetime.Value = ""
GoTo Start
End If
If Me.CheckBattvoltgauge.Value = False Then
Else
.Cells(iRow, 9).Value = "Battery Voltage Gauge"
.Cells(iRow, 10).Value = "Battery Voltage Gauge"
.Cells(iRow, 11).Value = Me.txtbatvoltgagetime.Value
Me.CheckBattvoltgauge.Value = False
Me.txtbatvoltgagetime.Value = ""
GoTo Start
End If
If Me.CheckCAC.Value = False Then
Else
.Cells(iRow, 9).Value = "Charged Air Cooler"
.Cells(iRow, 10).Value = "Charged Air Cooler"
.Cells(iRow, 11).Value = Me.txtCACtime.Value
Me.CheckCAC.Value = False
Me.txtCACtime.Value = ""
GoTo Start
End If
If Me.CheckEngineStart.Value = False Then
Else
.Cells(iRow, 9).Value = "Engine Start Issue"
.Cells(iRow, 10).Value = "Engine Start Issue"
.Cells(iRow, 11).Value = Me.txtenginestarttime.Value
Me.CheckEngineStart.Value = False
Me.txtenginestarttime.Value = ""
GoTo Start
End If
If Me.CheckEngineStop.Value = False Then
Else
.Cells(iRow, 9).Value = "Engine Stop Issue"
.Cells(iRow, 10).Value = "Engine Stop Issue"
.Cells(iRow, 11).Value = Me.txtenginestoptime.Value
Me.CheckEngineStop.Value = False
Me.txtenginestoptime.Value = ""
GoTo Start
End If
If Me.CheckEnginePerf.Value = False Then
Else
.Cells(iRow, 9).Value = "Engine Performance"
.Cells(iRow, 10).Value = Me.txtengineperformdescript.Value
.Cells(iRow, 11).Value = Me.txtengineperformtime.Value
Me.CheckEnginePerf.Value = False
Me.txtengineperformtime.Value = ""
Me.txtengineperformdescript.Value = ""
GoTo Start
End If
If Me.CheckAltnr.Value = False Then
Else
.Cells(iRow, 9).Value = "Alternator"
.Cells(iRow, 10).Value = "Alternator"
.Cells(iRow, 11).Value = Me.txtaltrtime.Value
Me.CheckAltnr.Value = False
Me.txtaltrtime.Value = ""
GoTo Start
End If
If Me.CheckCoolloopsole.Value = False Then
Else
.Cells(iRow, 9).Value = "Cooling Loop Solenoid"
.Cells(iRow, 10).Value = "Cooling Loop Solenoid"
.Cells(iRow, 11).Value = Me.txtcoolloopsoletime.Value
Me.CheckCoolloopsole.Value = False
Me.txtcoolloopsoletime.Value = ""
GoTo Start
End If
If Me.CheckFuelsole.Value = False Then
Else
.Cells(iRow, 9).Value = "Fuel Solenoid"
.Cells(iRow, 10).Value = "Fuel Solenoid"
.Cells(iRow, 11).Value = Me.txtfuelsoletime.Value
Me.CheckFuelsole.Value = False
Me.txtfuelsoletime.Value = ""
GoTo Start
End If
If Me.CheckHeater.Value = False Then
Else
.Cells(iRow, 9).Value = "Heater"
.Cells(iRow, 10).Value = "Heater"
.Cells(iRow, 11).Value = Me.txtheatertime.Value
Me.CheckHeater.Value = False
Me.txtheatertime.Value = ""
GoTo Start
End If
If Me.CheckFlywheel.Value = False Then
Else
.Cells(iRow, 9).Value = "Flywheel"
.Cells(iRow, 10).Value = "Flywheel"
.Cells(iRow, 11).Value = Me.txtflywheeltime.Value
Me.CheckFlywheel.Value = False
Me.txtflywheeltime.Value = ""
GoTo Start
End If
If Me.CheckWrongcomp.Value = False Then
Else
.Cells(iRow, 9).Value = "Wrong Component used in assembly"
.Cells(iRow, 10).Value = "Wrong Component used in assembly"
.Cells(iRow, 11).Value = Me.txtwrongcomptime.Value
Me.CheckWrongcomp.Value = False
Me.txtwrongcomptime.Value = ""
GoTo Start
End If

If Me.CheckOther.Value = False Then
Else
.Cells(iRow, 9).Value = "Tachometer"
.Cells(iRow, 10).Value = Me.txtotherdescpt.Value
.Cells(iRow, 11).Value = Me.txtothertime.Value
Me.CheckOther.Value = False
Me.txtothertime.Value = ""
GoTo Start
End If
.Cells(iRow, 1).Value = ""
.Cells(iRow, 2).Value = ""
.Cells(iRow, 3).Value = ""
.Cells(iRow, 4).Value = ""
.Cells(iRow, 5).Value = ""
.Cells(iRow, 6).Value = ""
.Cells(iRow, 7).Value = ""
.Cells(iRow, 8).Value = ""
.Cells(iRow, 13).Value = ""
.Cells(iRow, 14).Value = ""
.Cells(iRow, 15).Value = ""
.Cells(iRow, 16).Value = ""
' .Protect Password:="password"
End With
Me.txtjo.Value = ""
Me.txtdte.Value = ""
Me.txtmdl.Value = ""
Me.txtsrl.Value = ""
Me.txttchn.Value = ""
Me.txtep.Value = ""
Me.txthtvlt.Value = ""
Me.txtwt.Value = ""
Me.txtRprcmnt.Value = ""
Me.OptionButtondynoyes.Value = ""
Me.txtdynotechinitials.Value = ""
Me.txtleadmaninitials.Value = ""
Me.txtjo.SetFocus
End Sub


Private Sub Form_Load()
ComboBoxMECAByesno.AddItem [,Yes]
ComboBoxMECAByesno.AddItem [,No]
End Sub


Private Sub cmdClose_Click()
Unload Me
End Sub


Private Sub UserForm_QueryClose(Cancel As Integer, _
CloseMode As Integer)
If CloseMode = vbFormControlMenu Then
Cancel = True
MsgBox "Please use the Close Form button!"
End If
End Sub
 
Last edited:
Upvote 0

Forum statistics

Threads
1,223,910
Messages
6,175,318
Members
452,634
Latest member
cpostell

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top