Allow user to input into worksheet

dmqueen

Board Regular
Joined
Aug 5, 2014
Messages
53
Hello,

I have diligently trying to write a VBA program that guides user input from column to column in a worksheet, verifying that an entry was made. It begins by inserting a new row for entry and generating a par number base sequentially on the last entry- this works! )
Then t should allow freeform entry into open columns, selections when there is a listbox. - this doesn't :(.

I've tried calling an inputbox subroutine, and typing directly into the sheet. All I want to do is verify that an entry was made for every column, except Notes, which can be blank. If I rip out any more hair I'll be bald.
I've got Intermediate exp. doing this, but obviously not enough. I don't want to leave these people hanging, please help!
All my code is below. The file has multiple worksheets with similar info., but varying columns, both info and number.

<code>
'Written By: Dawn Queen
'For: Tools For Bending
'On: August 15, 2014
'Contact: dmcole@mail.com
'Purpose: Guide Input for Engineers and track Parts Created for Clients
'Converted Historical Lotus file and rewrote and updated scripting

Option Explicit
Private Sub Workbook_Activate()
Application.MoveAfterReturnDirection = xlToRight
End Sub
Sub MyCaller()
Dim rngV As Range, rngR As Range

Set rngV = Range("A1:A10")
Set rngR = Range("B1:B10")
Call CalledProc(rngVal:=rngV, rngRef:=rngR)

MsgBox "RngV: " & rngV.Address & vbCr & _
"RngR: " & rngR.Address

End Sub

Sub CalledProc(ByVal rngVal As Range, ByRef rngRef As Range)
rngVal.Interior.Color = vbYellow
rngRef.Interior.Color = vbRed

Set rngVal = Range("A11:A20")
Set rngRef = Range("B11:B20")
End Sub
Public Sub fInputPart()
'col A
'add a new row
'get last PartNo.
'add 1
'generate new part no.
'CurrentWorksheet.Activate()
ActiveSheet.Range("A1").Select
'goto the top, and cycle down each line until you find the top of the entries, "="
'goto the top entry ready to insert the new entry
While ActiveCell.Value <> "="
ActiveCell.Offset(1, 0).Activate
Wend
'OK, we found the top of the entries
'Don't overwrite the =, go below
ActiveCell.Offset(1, 0).Activate
'insert the new entry row
Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
'note where we are
Dim NewRowNum As Integer
NewRowNum = ActiveCell.Row
'Application defined or object defined error 1004
'Problem with line below!!
'Range("A" & ActiveCell.Row).Select
'Goto last part number entry
'Get the last part number here!!
Application.ActiveCell.Offset(1, 0).Activate
Dim LastPartNO As Integer
'Put the new part number here!!
Dim NewPartNo As String
NewPartNo = FgenerateNextPartNumber(Application.ActiveCell.Value)
Range("A" & NewRowNum).Value = NewPartNo
'debugging
'Call MsgBox("NewPartNo is: " & NewPartNo)
'Call MsgBox("Row Num 2 insert Part Num @ is: " & NewRowNum)
'this next line is VITAL or it will hang INDEFINETLY!
Application.Range("A" & NewRowNum).Value = NewPartNo
'go to next col
'col B
'verify entry was made
'go to next col
'while there are columns for data entry (has column title) verify entry was made in last column,
'error msg if not,
'go to next column if made
'Part Number in- goto next column and start loop
'If we've moved off target row, move back to it!
Application.ActiveCell.Offset(0, 1).Activate
If ActiveCell.Row <> NewRowNum Then
Application.ActiveCell.Offset(-1, 0).Activate
'Application.ActiveCell.Row() = NewRowNum
'Application.ActiveCell.Column & NewRowNum.Activate()
End If
'KEEP While loop LINE BREAKPOINTED UNTIL INPUT LOOP WORKING!!
'/******************************************************************************
'While the column is empty, and not NOTES there should be an entry/selection or we cannot continue.
'accept value entries & copy listbox selections 2 columns!!
While (NewRowNum & Application.ActiveCell.Column <> "")
'fGetInput(NewRowNum,ActiveCell.Column)
'When Enter key hit, ck that value entered and goto next column
'On KeypressByVal(KeyAscii As MSForms.ReturnInteger)
'If KeyAscii = 13 Then
'Application.ActiveCell.Value =
'while there are columns left for entry: there is a column header
'go to the next column for entry that is active and has a width not equal to 1
'verify entry was made in last column: holler and stop if not: continue if made
'blank allowed only for "NOTES" column!
'/******************************************************************************
'REVISE THIS TO SEARCH FROM TOP ROW, DON'T ASSUME IT'LL BE ON ROW 6!
If ActiveCell.Offset(0, 1) = Null Then
Range(ActiveCell.Column & "6").Select
If (ActiveCell.Value()) <> "NOTES" Then

Call MsgBox(":( Please enter/select a value in the previous column!", vbCritical, Application.Name)

Else
'if inactive(width=1, jump it, else goto next column and stop for entry
If ActiveCell.Offset(0, 1).ColumnWidth = 1 Then
ActiveCell.Offset(0, 2).Activate
Else: ActiveCell.Offset(0, 1).Activate
End If
End If
End If
'End If
Wend
Call MsgBox("Entry Complete, thank you! Don't forget to save when done! :)", vbInformation, Application.Name)
End Sub
Public Function FgenerateNextPartNumber(LastPartIn As String) As String
Dim LastPartNO As String
LastPartNO = LastPartIn
'LastPartNo = ActiveCell.Value
Dim NewStrPartNo As String
Dim strseparator As String
Dim strPartNo As String
Dim strLastPartNo As String

strPartNo = ActiveSheet.Name()
Dim strTrimWksName As String
'Pull part number from worksheet name
strTrimWksName = Left(strPartNo, 3)
strPartNo = strTrimWksName
Dim strSeperator As String

'/*****************************************************
'adjust to keep leading zeros!
'& accomodate longer part numbers-at least 5 digits!
strLastPartNo = Right(LastPartIn, 4)

Dim strNewSeqPartNo As String
Dim intNewSeqNo As Integer
Dim intLastSeqNo As Integer
Dim lastseqNo As Integer

'debugging
'Call MsgBox("strLastPartNo: " & strLastPartNo)
Dim tempConvert As Integer
tempConvert = CInt(strLastPartNo)

intLastSeqNo = tempConvert
intNewSeqNo = intLastSeqNo + 1
'if leading zero, put it back in
If Left(intLastSeqNo, 4) = "0" Then
intNewSeqNo = "0" & intNewSeqNo
End If
'handle special case separators HERE!
'debugging
'Call MsgBox("Generating Part Number! Last Part No. was " & intLastSeqNo)
If strPartNo = "180" Or strPartNo = "300" Or strPartNo = "310" Or strPartNo = "320" Or strPartNo = "330" Or strPartNo = "970" Or strPartNo = "681" Or strPartNo = "981" Then
strseparator = "-1-"

Else: strseparator = "-0-"
End If
'put in return stmt 4 compiler
NewStrPartNo = strPartNo + strseparator + "0" + CStr(intNewSeqNo)
NewStrPartNo = strPartNo + strseparator + CStr(intNewSeqNo)
'return statement
FgenerateNextPartNumber = NewStrPartNo

End Function
'Sub fgetInput(WhereRow, WhereCol)
'Dim target As String
'Dim myRange As Range
'Set Range = WhereRow,WhereCol
'target = InputBox("Enter Cell Value")
'Range(myRange).Select
'Range(myRange) = target
'End Sub

</code>
Please feel free to comment on my coding as well.
 

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes
When dealing with something like this, I like to give them one workbook that is set up just for their data entry. All error checking and validation is handled there. Give them a Button to click on when they are finished with their entry, then code will run to do all the checks and then copy the info over to another workbook used as a log file.

I find it makes things a easier when you break it up like that. This also keeps the user away from your data (no accidental deletions, erasures of formulas, etc.).

Then, if the data needs to be viewed, I'll give them a button that opens the Log file, copies it, closes the original, and inserts VBA code into the copy that prevents saving (to avoid multiple copies all over the Network).

Trying to enter, store, and display your data all within one workbook can get pretty complicated.

Sorry I can't assist with your coding, you're using a lot of stuff I haven't played around with yet.

Good luck. :)
 
Upvote 0
Thank you Kent! You've made me see the light! I've been trying to code it in the same style the structured code on every worksheet that walked them through input in the Lotus file I converted from, but I can't: I instinctively knew that I wanted one piece of code for all the sheets, and listboxes for the written out choices in the structured code. I NEED A BUTTON AT THE END! Then I can validate the input, and check for blanks, copy the listbox.bounditem.value to the cell and thank the user. Sorry I'm going on a bit, this has been plaguing me for weeks and now I see I've been going about it wrong. Love you dude!:eek:;)
 
Upvote 0
I'm glad I could be of assistance. I've received so much help from members of this forum, it's nice to be able to give a little back. Feel free to let me know if I can be of any further assistance. Happy coding! :)
 
Upvote 0

Forum statistics

Threads
1,215,425
Messages
6,124,826
Members
449,190
Latest member
rscraig11

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