Multiple Line Text Box to Multiple Rows in WS

[Mik]

I have a basic Userform order entry in which I input the following data:

Date
Customer
Ship To Address
Purchase Order #
Parts ordered
Expected Ship Date
Name Of Person Entering Data

I have created the basic functional userform, but as it stands now I can only input a single "part" ("Parts ordered") at a time. Everything else works fine. I would like to be able to Input all the data here, including several items per PO. As it stands now, I can enter multiple items in my "Parts" textbox, but on the worksheet the items are smashed into one cell. How do I get each multiple line in the "parts" textbox to fill its own descending cell (and copy the other info on each corresponding line)?

 

[ChrisOswald]

Hi,

Without seeing how you're doing this, I can't give you exact code, but, if I'm guessing your approach correctly you can do this with a combination of VBA's Split() function and a loop.

Simplified sample code

Sub Simplified()
'These first 3 items would be the raw strings from the userform
    Dim strPartNbr                  As String
    Dim StrTbOne                    As String
    Dim StrTbTwo                    As String
 
    'Last used row on spreadsheet  I'm assuming you aren't having any problems
    'getting this
    Dim LR                          As Long
    'These two variables are to split out the partnumber and loop through them
    Dim i                           As Long
    Dim varPartNbr                  As Variant
 
    'Used to keep track of the row you're outputting to.
    Dim RowCount                    As Long
    'Pretend entries
    StrTbOne = "1/1/2011"
    StrTbTwo = "Bobs Bait Shack"
    'using a comma delimiter (you can replace with something else in the split
    'function or do something fancier allowing multiple delimiters
    strPartNbr = "123,678"
    varPartNbr = Split(strPartNbr, ",")
 
    'start entry at first empty row
    '(This would be a good place to actually find the value of LR :) )
    LR = 2
 
    RowCount = LR + 1
    For i = LBound(varPartNbr) To UBound(varPartNbr)
    'change the sheet reference to fit
        Worksheets("Sheet1").Cells(RowCount, 1) = StrTbOne
        Worksheets("Sheet1").Cells(RowCount, 2) = StrTbTwo
        Worksheets("Sheet1").Cells(RowCount, 3) = varPartNbr(i)
        RowCount = RowCount + 1
    Next i
End Sub

 

[Mik]

Thanks for the input. Here's what my code currently looks like:

Private Sub CMDEnterOrder_Click()
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("PartsData")

'find first empty row in database
iRow = ws.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0).Row

'check for a Customer
If Trim(Me.TxtCustomer.Value) = "" Then
Me.TxtCustomer.SetFocus
MsgBox "Please enter a customer"
Exit Sub
End If

'copy the data to the database
ws.Cells(iRow, 1).Value = Me.TxtDate.Value
ws.Cells(iRow, 2).Value = Me.TxtCustomer.Value
ws.Cells(iRow, 3).Value = Me.TxtPO.Value
ws.Cells(iRow, 4).Value = Me.TxtLoc.Value
ws.Cells(iRow, 5).Value = Me.TxtPart.Value
ws.Cells(iRow, 6).Value = Me.TxtQty.Value
ws.Cells(iRow, 7).Value = Me.TxtESD.Value
ws.Cells(iRow, 8).Value = Me.TxtEntBy.Value

'clear the data
Me.TxtDate.Value = ""
Me.TxtCustomer.Value = ""
Me.TxtPO.Value = ""
Me.TxtLoc.Value = ""
Me.TxtPart.Value = ""
Me.TxtQty.Value = ""
Me.TxtESD.Value = ""
Me.TxtEntBy.Value = ""
Me.TxtCustomer.SetFocus
End Sub


How would you alter this to incorporate what you referred to in your reply?

 

[ChrisOswald]

Sorry about the delay.

Test this out.

Private Sub CMDEnterOrder_Click()
    Dim iRow                        As Long
    Dim ws                          As Worksheet
    Dim PartNbrs                    As Variant
    Dim j                           As Long
    Set ws = Worksheets("PartsData")
    'find first empty row in database
    iRow = ws.Cells(Rows.Count, 1) _
           .End(xlUp).Offset(1, 0).Row
    'check for a Customer
    If Trim(Me.TxtCustomer.Value) = "" Then
        Me.TxtCustomer.SetFocus
        MsgBox "Please enter a customer"
        Exit Sub
    End If
    'Check to make sure that TxtPart is splittable
    If InStr(Me.TxtPart.Value, ",") > 0 Then
        PartNbrs = Split(Me.TxtPart.Value, ",")
    Else
        PartNbrs = Array(Me.TxtTart.Value)
    End If
    For j = LBound(PartNbrs) To UBound(PartNbrs)
        'copy the data to the database
        ws.Cells(iRow + j, 1).Value = Me.TxtDate.Value
        ws.Cells(iRow + j, 2).Value = Me.TxtCustomer.Value
        ws.Cells(iRow + j, 3).Value = Me.TxtPO.Value
        ws.Cells(iRow + j, 4).Value = Me.TxtLoc.Value
        ws.Cells(iRow + j, 5).Value = PartNbrs(j)
        ws.Cells(iRow + j, 6).Value = Me.TxtQty.Value
        ws.Cells(iRow + j, 7).Value = Me.TxtESD.Value
        ws.Cells(iRow + j, 8).Value = Me.TxtEntBy.Value
    Next j
    'clear the data
    Me.TxtDate.Value = ""
    Me.TxtCustomer.Value = ""
    Me.TxtPO.Value = ""
    Me.TxtLoc.Value = ""
    Me.TxtPart.Value = ""
    Me.TxtQty.Value = ""
    Me.TxtESD.Value = ""
    Me.TxtEntBy.Value = ""
    Me.TxtCustomer.SetFocus
End Sub

 

[Mik]

Chris,

Thank you so much. Your code worked like a charm. And thanks to you, my order tracking is now 10 times as efficient. I can't thank you enough.
One more question for you: thanks to you I can now punch in multiple Parts for each PO, but I'd also like to be able to input the quantity for each of these parts. I know I could just punch it in the "Part" column as, for example, "2 cases 1295", but is there a way to have multiple rows for "Parts" that match with multiple rows for "Qty"? Given the code you hammered out for me, how would you recommend I tackle this dilemma (and believe me, it's a dilemma I don't mind having--I'm just glad to be able to punch in multiple items at all)? What modifications ought I make to the "Qty" textbox, and how ought I alter the code, if at all?
Thanks again for all your help.

 

[ChrisOswald]

Well, now we're getting into form design type questions, which, for me at least, is more an artform than it is a science.

Yes, you could do something like having people enter "2 cases 1295" and have the code tease it apart, (although, personly, I'd suggest something more like "1295q2,1296q1" or "1295 2,1296 1"). You might also be able (not sure, never really tried it) be able to set up some sort of 2 column list control for data entry. You could set up a really customized worksheet with cells pretending to be text boxes. You could set up a second form just with qty and part # that adds items to a listbox on your main form.

Of course, a couple of major constraints on your design decisions are your skill level/time willing to spend to increase skill level and number of users/skillset of users. And, you'll probably want to take into account that the users skillsets can change pretty dramaticly over time -- If you're the only user, you can pretty much expect the next person to do this job is going to have a different skill set.

 

[Mik]

Chris,

Thanks for the advice. If I went ahead with your example of inputing "1295 2,..." how would I code to break it apart into two columns, one being the "Part" column, and the other a column with the header "Qty"?

 

[ChrisOswald]

You're going to really need to add some data entry error handling to this. (Part of the whole art and science of form design)

Private Sub CMDEnterOrder_Click()
    Dim iRow                        As Long
    Dim ws                          As Worksheet
    Dim PartNbrs                    As Variant
    Dim j                           As Long
    Dim SecondSplit As Variant
 
    Set ws = Worksheets("PartsData")
    'find first empty row in database
    iRow = ws.Cells(Rows.Count, 1) _
           .End(xlUp).Offset(1, 0).Row
    'check for a Customer
    If Trim(Me.TxtCustomer.Value) = "" Then
        Me.TxtCustomer.SetFocus
        MsgBox "Please enter a customer"
        Exit Sub
    End If
    'Check to make sure that TxtPart is splittable
    If InStr(Me.TxtPart.Value, ",") > 0 Then
        PartNbrs = Split(Me.TxtPart.Value, ",")
    Else
        PartNbrs = Array(Me.TxtTart.Value)
    End If
    For j = LBound(PartNbrs) To UBound(PartNbrs)
        'copy the data to the database
 
        'starting to get a bit jumbled....
        SecondSplit = Split(PartNbrs(j), " ")
 
 
        ws.Cells(iRow + j, 1).Value = Me.TxtDate.Value
        ws.Cells(iRow + j, 2).Value = Me.TxtCustomer.Value
        ws.Cells(iRow + j, 3).Value = Me.TxtPO.Value
        ws.Cells(iRow + j, 4).Value = Me.TxtLoc.Value
 
 
        ws.Cells(iRow + j, 5).Value = SecondSplit(0)
        ws.Cells(iRow + j, 6).Value = SecondSplit(1)
 
 
        ws.Cells(iRow + j, 7).Value = Me.TxtESD.Value
        ws.Cells(iRow + j, 8).Value = Me.TxtEntBy.Value
    Next j
    'clear the data
    Me.TxtDate.Value = ""
    Me.TxtCustomer.Value = ""
    Me.TxtPO.Value = ""
    Me.TxtLoc.Value = ""
    Me.TxtPart.Value = ""
    Me.TxtQty.Value = ""
    Me.TxtESD.Value = ""
    Me.TxtEntBy.Value = ""
    Me.TxtCustomer.SetFocus
End Sub

 

[Mik]

Thanks again for all your time and input.
So my order entry userform works great now, but I'm stuck on something. I'd like to be able to have a running list of all "Parts" on order with their "Qty" on a 2nd WS titled "Parts", and I am trying to get the list to aggregate items together. For example, if there are 2 separate orders for 1 case of 1295, the list would show "1295 2". Would you recommend I set this up via the userform (and how would I code for that?), or by some other method?
I'd also like a method for removing the "Parts" and "Qty" for each order from the running list of On Order Parts, something like a simple button I can click at the end of each row to note that this particular Order has shipped. Would you recommend I add a shipping userform, something like a search by with the ability to copy the row and move it to a 3rd "History" ws and remove the original row, or just a button of some kind?

 

[NHagedorn]

Dim iRow As Long
Dim ws As Worksheet
Dim PartNbrs As Variant
Dim j As Long
Set ws = Worksheets("PartsData")
'find first empty row in database
iRow = ws.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0).Row
'check for a Customer
If Trim(Me.TxtCustomer.Value) = "" Then
Me.TxtCustomer.SetFocus
MsgBox "Please enter a customer"
Exit Sub
End If
'Check to make sure that TxtPart is splittable
If InStr(Me.TxtPart.Value, ",") > 0 Then
PartNbrs = Split(Me.TxtPart.Value, ",")
Else
PartNbrs = Array(Me.TxtTart.Value)
End If
For j = LBound(PartNbrs) To UBound(PartNbrs)


Should line above be TxtPart.Value?

Private Sub CMDEnterOrder_Click()
    Dim iRow                        As Long
    Dim ws                          As Worksheet
    Dim PartNbrs                    As Variant
    Dim j                           As Long
    Set ws = Worksheets("PartsData")
    'find first empty row in database
    iRow = ws.Cells(Rows.Count, 1) _
           .End(xlUp).Offset(1, 0).Row
    'check for a Customer
    If Trim(Me.TxtCustomer.Value) = "" Then
        Me.TxtCustomer.SetFocus
        MsgBox "Please enter a customer"
        Exit Sub
    End If
    'Check to make sure that TxtPart is splittable
    If InStr(Me.TxtPart.Value, ",") > 0 Then
        PartNbrs = Split(Me.TxtPart.Value, ",")
    Else
        PartNbrs = Array(Me.TxtTart.Value)
    End If

[/QUOTE]