multiline textbox data to be pasted in multiple rows in vba

[VaibhavAr]

excel1.jpgtestmacro.xlsm

Please refer the attached files. I have a multiline textbox where I can enter random data. This data gets pasted on the excel sheet in a single cell. I want the data to be on different cells as given in the picture. The data can be 20 - 25 lines in every multiline textbox.

Please help me solve this as I have to apply it to one of our company forms.

[cytop]

Split the contents of the textbox into a variant array using the SPLIT() function and (probably) vbCrLf as the delimiter
Resize the cell to update with the values using the UBound of the array +1 (if the array lower bound is 0).
Transpose the array into the resized range.

for example:

Please Login or Register  to view this content.

IMO - That is really not a good way to input multiple lines of data

[VaibhavAr]

Dear cytop,

Can you please send me the complete code as I am not so good with the coding. It would be of great help.

[cytop]

Ignoring the fact your name appears in the file properties as both Author and Last Edited By - Have you even looked at the code?

[cytop]

It seems the OP decided to log off after my last post.

The reason for the question was that the procedure already contains code to update multiple lines. It's commented out at the top of the procedure. I didn't notice it as I just dipped into the VBA editor and copied one line from the procedure to illustrate my first reply - strangely enough, except that it uses a varaible named 'a' rather than 'v', it's identical.

[VaibhavAr]

Thank you for that. It works perfectly.

[VaibhavAr]

Hi Cytop. Sorry for disturbing again. I am getting a "Range of object" Global failed error in the following code. Please help.

Private Sub cbocategory_Change()
Application.EnableEvents = False
cbosubcategory.Clear
Application.EnableEvents = True

Select Case cbocategory.Value
Case "Gelcoat"
cbosubcategory.AddItem "Chip Off"
cbosubcategory.AddItem "Star Mark / Crack"
cbosubcategory.AddItem "Color Fading"
cbosubcategory.AddItem "Color Spliting"
cbosubcategory.AddItem "Wear Out"
cbosubcategory.AddItem "Color Mismatch"
cbosubcategory.AddItem "Air Bubble"
cbosubcategory.AddItem "Blow Holes"
cbosubcategory.AddItem "Orange Peel Effect"
cbosubcategory.AddItem "Parting Line"
Case "Molds"
cbosubcategory.AddItem "Pin Holes"
cbosubcategory.AddItem "Parting Line"
cbosubcategory.AddItem "Bumps"
cbosubcategory.AddItem "Gaps Between Modules"
cbosubcategory.AddItem "Not As Per Design"
cbosubcategory.AddItem "Star Mark / Crack"
cbosubcategory.AddItem "Air Bubble"
Case "Dimensions"
cbosubcategory.AddItem "Non-Uniform Flange Width"
cbosubcategory.AddItem "Non-Uniform Thickness of Flange"
cbosubcategory.AddItem "No Holes"
cbosubcategory.AddItem "Size of Cutouts in FRP"
cbosubcategory.AddItem "Wrong Hole Spacing & Size Uneven"
cbosubcategory.AddItem "Improper Holes"
cbosubcategory.AddItem "Improper Flange Angles"
cbosubcategory.AddItem "Length Not As Per Design"
Case "Testing"
cbosubcategory.AddItem "Pretest Not Carried Before Dispatch"
Case "Back Coating"
cbosubcategory.AddItem "Color Mismatch"
cbosubcategory.AddItem "Surface Finish"
cbosubcategory.AddItem "Uniform Thickness"
Case "Painting"
cbosubcategory.AddItem "Color Peel Off"
cbosubcategory.AddItem "Color Not as per Design"
Case "Improper Handling"
cbosubcategory.AddItem "NA"
Case "Manufacturing"
cbosubcategory.AddItem "Not as per Design"
cbosubcategory.AddItem "Wrong Purchase"
cbosubcategory.AddItem "Rusting"
cbosubcategory.AddItem "Defect"
Case "Painting Metal"
cbosubcategory.AddItem "Rusting (Painting)"
cbosubcategory.AddItem "Peel Off"
cbosubcategory.AddItem "Color Mismatch"
cbosubcategory.AddItem "Color Chipoff"
Case "FRP"
cbosubcategory.AddItem "Wrong Palleting"
cbosubcategory.AddItem "Improper Wrapping"
cbosubcategory.AddItem "Mishandling"
cbosubcategory.AddItem "Accident"
Case "Steel"
cbosubcategory.AddItem "Improper Wrapping / Loading"
cbosubcategory.AddItem "Mishandling"
Case "Aluminium"
cbosubcategory.AddItem "Improper Wrapping"
cbosubcategory.AddItem "Mishandling"
Case "Manufacturing FRP"
cbosubcategory.AddItem "Defect"
cbosubcategory.AddItem "Asthetic Requirement"
cbosubcategory.AddItem "Not as per Design"
Case "Manual Error"
cbosubcategory.AddItem "Not Mentioned In Design"
cbosubcategory.AddItem "Not Mentioned In BOM"
cbosubcategory.AddItem "Wrong BOM"
cbosubcategory.AddItem "Design Not Verified"
cbosubcategory.AddItem "Short in BOM"
Case "Loading"
cbocategory.AddItem "FRP & Steel Loaded Together"
End Select
End Sub

Private Sub cbodatemonth_Change()
If Me.cbodatemonth.Value = "January" Then
Me.txtquarter.Value = "IV"
ElseIf Me.cbodatemonth.Value = "February" Then
Me.txtquarter.Value = "IV"
ElseIf Me.cbodatemonth.Value = "March" Then
Me.txtquarter.Value = "IV"
ElseIf Me.cbodatemonth.Value = "April" Then
Me.txtquarter.Value = "I"
ElseIf Me.cbodatemonth.Value = "May" Then
Me.txtquarter.Value = "I"
ElseIf Me.cbodatemonth.Value = "June" Then
Me.txtquarter.Value = "I"
ElseIf Me.cbodatemonth.Value = "July" Then
Me.txtquarter.Value = "II"
ElseIf Me.cbodatemonth.Value = "August" Then
Me.txtquarter.Value = "II"
ElseIf Me.cbodatemonth.Value = "September" Then
Me.txtquarter.Value = "II"
ElseIf Me.cbodatemonth.Value = "October" Then
Me.txtquarter.Value = "III"
ElseIf Me.cbodatemonth.Value = "November" Then
Me.txtquarter.Value = "III"
ElseIf Me.cbodatemonth.Value = "December" Then
Me.txtquarter.Value = "III"
End If
End Sub

'Private Sub cbosubcategory_Change()
'If Me.cbocategory.Value = "NA" Then
'Me.cbosubcategory.Value = "NA"
'End If
'End Sub


Private Sub cmdclear_Click()
For Each ctl In Me.Controls
If TypeName(ctl) = "TextBox" Or TypeName(ctl) = "ComboBox" Then
ctl.Value = ""
ElseIf TypeName(ctl) = "CheckBox" Then
ctl.Value = False
End If
Next ctl
End Sub


Private Sub txtmonth_Change()
'Dim a As Variant
'Me.txtdate.Value = Me.txtmonth.Value
'Me.txtmonth.Text = Month(Date)
'If Me.txtdate.Text = DateValue(Me.txtdate.Value) Then
'txtmonth.Text = Month(Me.txtdate.Value)
'End If
End Sub


Private Sub cmdsubmit_Click()

If Not IsDate(Me.txtdate.Value) Then
MsgBox "The Complaint Date box must contain a date", vbExclamation
Me.txtdate.SetFocus
Exit Sub
End If

If Not IsDate(Me.txtifsosdate.Value) Then
MsgBox "The SOS Date box must contain a date", vbExclamation
Me.txtifsosdate.SetFocus
Exit Sub
End If

If Not IsDate(Me.txtcomplaintexpdate.Value) Then
MsgBox "The Complaint Expected Date box must contain a date", vbExclamation
Me.txtcomplaintexpdate.SetFocus
Exit Sub
End If

Dim a() As String
a() = Split(txtpart.Value, vbCrLf)
Range("datarange").Resize(UBound(a) + 1, 1).Value = WorksheetFunction.Transpose(a)

Dim b() As String
b() = Split(txtquantity.Value, vbCrLf)
Range("datarange").Resize(UBound(b) + 1, 1).Value = WorksheetFunction.Transpose(b)

Dim c() As String
c() = Split(txtuom.Value, vbCrLf)
Range("datarange").Resize(UBound(b) + 1, 1).Value = WorksheetFunction.Transpose(b)

Dim d() As String
d() = Split(txtmaterialamount.Value, vbCrLf)
Range("datarange").Resize(UBound(b) + 1, 1).Value = WorksheetFunction.Transpose(b)

Dim RowCount As Long
Dim ctl As Control
RowCount = Worksheets("Sheet2").Range("A1").CurrentRegion.Rows.Count
With Worksheets("Sheet2").Range("A1")
.Offset(RowCount, 1).Value = Me.txtquarter.Value
.Offset(RowCount, 2).Value = Me.cbodatemonth.Value
.Offset(RowCount, 3).Value = DateValue(Me.txtdate.Value)
.Offset(RowCount, 4).Value = Me.txtcomplaintno.Value
.Offset(RowCount, 5).Value = Me.txtifsonumber.Value
.Offset(RowCount, 6).Value = Me.txtifsosnumber.Value
.Offset(RowCount, 7).Value = DateValue(Me.txtifsosdate.Value)
.Offset(RowCount, 8).Value = Me.cboproduct.Value
.Offset(RowCount, 9).Value = Me.cbotypeoforder.Value
.Offset(RowCount, 10).Value = Me.cbonatureofcomplaint.Value
.Offset(RowCount, 11).Value = Me.cbocategory.Value
.Offset(RowCount, 12).Value = Me.cbosubcategory.Value
.Offset(RowCount, 13).Value = Me.txtdescriptionofcomplaint.Value
.Offset(RowCount, 14).Value = Me.cboresponsibledept.Value
.Offset(RowCount, 15).Value = Me.txtcorrection.Value
.Offset(RowCount, 16).Resize(UBound(a) + 1).Value = WorksheetFunction.Transpose(a)
.Offset(RowCount, 17).Resize(UBound(b) + 1).Value = WorksheetFunction.Transpose(b)
.Offset(RowCount, 18).Resize(UBound(c) + 1).Value = WorksheetFunction.Transpose(c)
.Offset(RowCount, 19).Resize(UBound(d) + 1).Value = WorksheetFunction.Transpose(d)
.Offset(RowCount, 20).Value = Me.cboseverity.Value
.Offset(RowCount, 21).Value = DateValue(Me.txtcomplaintexpdate.Value)
End With


For Each ctl In Me.Controls
If TypeName(ctl) = "TextBox" Or TypeName(ctl) = "ComboBox" Then
ctl.Value = ""
ElseIf TypeName(ctl) = "CheckBox" Then
ctl.Value = False
End If
Next ctl
End Sub

Private Sub UserForm_Initialize()
cbonatureofcomplaint.AddItem "FRP Quality"
cbonatureofcomplaint.AddItem "Steel / Al"
cbonatureofcomplaint.AddItem "Damage In Transit"
cbonatureofcomplaint.AddItem "Lost at Site"
cbonatureofcomplaint.AddItem "Design Error"
cbonatureofcomplaint.AddItem "Communication Error"
cbonatureofcomplaint.AddItem "Accidents"
cbonatureofcomplaint.AddItem "Additional Requirements"
cbonatureofcomplaint.AddItem "Installation"
cbonatureofcomplaint.AddItem "Supply"
cbonatureofcomplaint.AddItem "Site Complaints"
cbonatureofcomplaint.AddItem "Complaint Accessories"
cbonatureofcomplaint.AddItem "Part Accessories"
cbonatureofcomplaint.AddItem "Delay"
cbonatureofcomplaint.AddItem "Systemization"
cbonatureofcomplaint.AddItem "Suggestion"
End Sub
Private Sub cbonatureofcomplaint_Change()
Application.EnableEvents = False
cbocategory.Clear
Application.EnableEvents = True

Select Case cbonatureofcomplaint.Value
Case "FRP Quality"
cbocategory.AddItem "Gelcoat"
cbocategory.AddItem "Molds"
cbocategory.AddItem "Dimensions"
cbocategory.AddItem "Testing"
cbocategory.AddItem "Back Coating"
cbocategory.AddItem "Painting"
cbocategory.AddItem "Improper Handling"
cbocategory.AddItem "Improper Matching"
cbocategory.AddItem "Manufacturing FRP"
Case "Steel / Al"
cbocategory.AddItem "Wrong Fabrication"
cbocategory.AddItem "Painting"
cbocategory.AddItem "Wrong Packing"
Case "Damage In Transit"
cbocategory.AddItem "FRP"
cbocategory.AddItem "Steel"
cbocategory.AddItem "Loading"
cbocategory.AddItem "Aluminium"
Case "Lost at Site"
cbocategory.AddItem "NA"
Case "Design Error"
cbocategory.AddItem "Manual Error"
cbocategory.AddItem "Wrong Design"
cbocategory.AddItem "Over Design"
Case "Communication Error"
cbocategory.AddItem "NA"
Case "Accidents"
cbocategory.AddItem "Design Error"
cbocategory.AddItem "Mfg. Error"
Case "Additional Requirements"
cbocategory.AddItem "NA"
Case "Installation"
cbocategory.AddItem "Wrong Installation"
Case "Supply"
cbocategory.AddItem "Wrong Foundation Marking"
cbocategory.AddItem "Short"
cbocategory.AddItem "Known Short"
cbocategory.AddItem "Wrong"
cbocategory.AddItem "Extra Supply:"
Case "Site Complaints"
cbocategory.AddItem "NA"
Case "Complaint Accessories"
cbocategory.AddItem "NA"
Case "Part Accessories"
cbocategory.AddItem "NA"
Case "Delay"
cbocategory.AddItem "Mould"
Case "Systemization"
cbocategory.AddItem "NA"
Case "Suggestion"
cbocategory.AddItem "NA"
End Select
End Sub



Private Sub cmdcancel_Click()
Unload Me
End Sub

[cytop]

You really can't be serious, can you?

You post over 200 lines of code saying "am getting a 'Range of object' Global failed error in the following code" without any indication where the error is or the steps needed to reproduce it and you expect someone else to find it?? I could assume the issue is something to do with your first question which would help to identify where in the code the error is; but that'd just be a guess. It could be wrong.

Sorry, I'm not going to spend time on this - and you should read the board rules, especially #3.

[VaibhavAr]

Thats why I had attached the file so that you can run it. I am not a coding expert. Whatever I have written is based on the knowledge gained from the internet. I am not even an IT engineer. I searched for this on the internet too but was not able to get anywhere so had to post it in such a forum hoping that someone will resolve my problems.

The code is:

Dim a() As String
a() = Split(txtpart.Value, vbCrLf)
Range("datarange").Resize(UBound(a) + 1, 1).Value = WorksheetFunction.Transpose(a)

and the code for output is

.Offset(RowCount, 16).Resize(UBound(a) + 1).Value = WorksheetFunction.Transpose(a)


Its ok if you don't want to help out. Thanks anyways.

[cytop]

You should still read the board rules:

3. Use code tags around code. Posting code without them makes your code hard to read and difficult to be copied for testing. Highlight your code and click the [#] button at the top of the post window (if you are editing an existing post, press Go Advanced to see the [#] button). The result will appear like this in the post window:

[code]Please [url=https://www.excelforum.com/login.php]Login or Register [/url] to view this content.[/code]

... and appear like this when posted:

Please Login or Register  to view this content.

You can also type the code tags in manually if you prefer. For more information about these and other tags, click here.

[VaibhavAr]

The code is like this:
I am getting error for the line marked in red.

Please Login or Register  to view this content.