Transfer to active sheet

[johnsonk]

Hi, I am problems getting the data that is populated on my userform to transfer to the active sheet when the command button is pressed any ideas ?

Private Sub Userform_Initialize()
With GetObject("\\FPS\USERS$\johnsonk\Desktop\Packaging\DataBase.xlsm")
ComboBox1.List = .Sheets("ALL").Range("B3:B500").Value
End With
End Sub
Private Sub ComboBox1_Change()
With GetObject("\\FPS\USERS$\johnsonk\Desktop\Packaging\DataBase.xlsm")
    TextBox1.Value = .Sheets("ALL").Range("A" & ComboBox1.ListIndex + 3).Value
TextBox2.Value = .Sheets("ALL").Range("C" & ComboBox1.ListIndex + 3).Value
TextBox3.Value = .Sheets("ALL").Range("N" & ComboBox1.ListIndex + 3).Value
TextBox4.Value = .Sheets("ALL").Range("S" & ComboBox1.ListIndex + 3).Value
TextBox5.Value = .Sheets("ALL").Range("O" & ComboBox1.ListIndex + 3).Value
TextBox6.Value = .Sheets("ALL").Range("P" & ComboBox1.ListIndex + 3).Value
TextBox7.Value = .Sheets("ALL").Range("Q" & ComboBox1.ListIndex + 3).Value
TextBox8.SetFocus
End With
End Sub
Private Sub TextBox8_exit(ByVal Cancel As MSForms.ReturnBoolean)
Call matchtext
End Sub
Sub matchtext()
If TextBox1.Value = "" Or TextBox8.Value = "" Then Exit Sub
If TextBox1.Value = TextBox8.Value Then
TextBox9 = ("MATCH")
ComboBox1.Text = ""
TextBox1.Text = ""
TextBox2.Text = ""
TextBox3.Text = ""
TextBox4.Text = ""
TextBox5.Text = ""
TextBox6.Text = ""
TextBox7.Text = ""
TextBox8.Text = ""
TextBox9.Text = ""
Else
TextBox9 = ("NO MATCH")
Dim sPath As String
result = MsgBox("NO MATCH YOU WILL NEED TO START AGAIN", vbOKOnly + vbCritical, "WARNING")
If result = vbOK Then
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
Dim wb As Workbook
On Error Resume Next
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
xMailBody = "WARNING MESSAGE" & vbNewLine & vbNewLine & _
"There has been a no match scanning error" & vbNewLine & _
""
On Error Resume Next
With xOutMail
.To = "[EMAIL]joe.blogs@blogs.co.uk[/EMAIL]"
.CC = ""
.BCC = ""
.Subject = "Holding Area Retail Door"
.Body = xMailBody
.Attacments = ActiveSheet
.Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing

ComboBox1.Text = ""
TextBox1.Text = ""
TextBox2.Text = ""
TextBox3.Text = ""
TextBox4.Text = ""
TextBox5.Text = ""
TextBox6.Text = ""
TextBox7.Text = ""
TextBox8.Text = ""
TextBox9.Text = ""
End If
End If
End Sub
Private Sub CommandButton1_Click()
Dim erow As Long
Application.DisplayAlerts = False
erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Cells(erow, 1) = ComboBox1.Text
Cells(erow, 2) = TextBox1.Text
Cells(erow, 3) = TextBox2.Text
Cells(erow, 4) = TextBox3.Text
Cells(erow, 5) = TextBox4.Text
Cells(erow, 6) = TextBox5.Text
Cells(erow, 7) = TextBox6.Text
Cells(erow, 8) = TextBox7.Text
Cells(erow, 9) = TextBox8.Text
Cells(erow, 10) = TextBox9.Text
Range("L" & Rows.Count).End(xlUp).Offset(1).Value = Now
ComboBox1.Text = ""
TextBox1.Text = ""
TextBox2.Text = ""
TextBox3.Text = ""
TextBox4.Text = ""
TextBox5.Text = ""
TextBox6.Text = ""
TextBox7.Text = ""
TextBox8.Text = ""
TextBox9.Text = ""
out2.Show
ActiveWorkbook.Save
Application.DisplayAlerts = True
End Sub

Regards

 

[johnsonk]

Forgot to mention it will transfer the date but nothing else.

 

[johnsonk]

Solved it I was clearing the textboxes after the match.