Using multipage to add data to worksheet

B

Bandito1

Board Regular
Joined
Oct 18, 2018
Messages
233
Office Version
  1. 2016
Platform
  1. Windows
Hello all,

I got the following form;
Capture.PNG


With this form i can add observations to my excel sheet named "Observations".
With the following code the data is added to Observations.

VBA Code: 
Private Sub cmdAddOberservation_Click()
    Dim fTextBox As Object
    Dim xEptTxtName As String
    
    For Each fTextBox In Productionreturns.Controls
        If TypeName(fTextBox) = "TextBox" Then
            If fTextBox.Text = "" Then
                xEptTxtName = xEptTxtName & fTextBox.Name & " is empty " & vbNewLine
            End If
        End If
  
    
    Next
        If xEptTxtName <> "" Then
            MsgBox "The following required fields are not complete;" & vbNewLine & vbNewLine & Chr(13) & xEptTxtName, vbInformation
        Exit Sub
        Else
    End If

If Worksheets("Observations").Range("A2").Value = "" Then
Worksheets("Observations").Range("A2:G2").FormulaArray = "1"
End If
Set Drng = Worksheets("Observations").Range("A1")

Drng.End(xlDown).Offset(1, 0).Value = Me.lblGelCodeR.Caption
Drng.End(xlDown).Offset(0, 1).Value = Me.lblProductNameR.Caption
Drng.End(xlDown).Offset(0, 2).Value = Me.lblBatchNumberR.Caption
Drng.End(xlDown).Offset(0, 3).Value = Me.lblBoxR.Caption
Drng.End(xlDown).Offset(0, 4).Value = Me.txtStDate.Value
Drng.End(xlDown).Offset(0, 5).Value = Me.txtCorrectBy.Value
Drng.End(xlDown).Offset(0, 6).Value = Me.txtEndDate.Value
Drng.End(xlDown).Offset(0, 7).Value = Me.txtCheckDate.Value
Drng.End(xlDown).Offset(0, 8).Value = Me.cboDocument.Value
Drng.End(xlDown).Offset(0, 9).Value = Me.cboDocumentPart.Value
Drng.End(xlDown).Offset(0, 10).Value = Me.cboPart.Value
Drng.End(xlDown).Offset(0, 11).Value = Drng.End(xlDown).Offset(-1, 8).Value + 1

Call MsgBox("A new observation has been added", vbInformation, "Add observation")

SortIt
Unload Me
On Error GoTo 0
Exit Sub

cmdAdd_Click_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure cmdAddObservation_Click of Form Productionreturns"

End Sub

Now i would like the same for Page 2 of the multipage. So i can add 2 observations at once.
For page 1 it works but how do I make it that when data is added to page 2 this data is entered beneath the data of page 1 in the sheet "observations"?
 
Sort by date Sort by votes
Hello Dante

I deleted and edited the code and it nearly works perfect now. Many thanks!
One thing that goes wrong;

When i fill in page 1 i go to page 2 and don't fill all required textboxes i get the message that i need to fill in the specific required textboxes.
This works.

The thing that goes wrong is that when i get the message that i didn't fill in all required textboxes on page 2 it already writes the data from page 1 to the worksheet.
So if i make 2 mistakes on page 2 and get 2 times the msgbox that i need to fill in textboxes on page 2 the data from page 1 is writed 2 times on the worksheet.

How do i "say" that only data is added to the worksheet when all required textboxes are filled when working in different pages?

Code: 
Private Sub cmdAddOberservation_Click()
  Dim fTextBox As Object, xEptTxtName As String
  Dim sh As Worksheet, lr As Long
 
  Set sh = Sheets("Observations")
 
  For Each fTextBox In Productionreturns.Controls
    If TypeName(fTextBox) = "TextBox" Then
      If fTextBox.Text = "" Then
        xEptTxtName = xEptTxtName & fTextBox.Name & " is empty " & vbNewLine
      End If
    End If
  Next
 
  If txtStDate.Text = "" Then
  MsgBox "Date of observation is left blank", , "Error"
  Productionreturns.MultiPage1.value = 0
  txtStDate.SetFocus
  Exit Sub
  End If
  
  If txtCorrectBy.Text = "" Then
  MsgBox "To correct by is left blank", , "Error"
  Productionreturns.MultiPage1.value = 0
  txtCorrectBy.SetFocus
  Exit Sub
  End If
  
  If txtEndDate.Text = "" Then
  MsgBox "Correction performed is left blank", , "Error"
  Productionreturns.MultiPage1.value = 0
  txtEndDate.SetFocus
  Exit Sub
  End If
  
  If txtCheckDate.Text = "" Then
  MsgBox "Checked on is left blank", , "Error"
  Productionreturns.MultiPage1.value = 0
  txtCheckDate.SetFocus
  Exit Sub
  End If
    
  'PAGE 1
  lr = sh.Range("A" & Rows.Count).End(xlUp).Row + 1
  sh.Cells(lr, "A").value = Me.lblGelCodeR.Caption
  sh.Cells(lr, "B").value = Me.lblProductNameR.Caption
  sh.Cells(lr, "C").value = Me.lblBatchNumberR.Caption
  sh.Cells(lr, "D").value = Me.lblBoxR.Caption
  sh.Cells(lr, "E").value = Me.txtStDate.value
  sh.Cells(lr, "F").value = Me.txtCorrectBy.value
  sh.Cells(lr, "G").value = Me.txtEndDate.value
  sh.Cells(lr, "H").value = Me.txtCheckDate.value
  sh.Cells(lr, "I").value = Me.cboDocument.value
  sh.Cells(lr, "J").value = Me.cboDocumentPart.value
  sh.Cells(lr, "K").value = Me.cboPart.value
  
  'PAGE 2
  If Me.txtStDate2.Text <> "" Then
  
  If txtStDate2.Text = "" Then
  MsgBox "Date of observation on page 2 is left blank", , "Error"
  Productionreturns.MultiPage1.value = 1
  txtStDate2.SetFocus
  Exit Sub
  End If
  
  If txtCorrectBy2.Text = "" Then
  MsgBox "To correct by on page 2 is left blank", , "Error"
  Productionreturns.MultiPage1.value = 1
  txtCorrectBy2.SetFocus
  Exit Sub
  End If
  
  If txtEndDate2.Text = "" Then
  MsgBox "Correction performed on page 2 is left blank", , "Error"
  Productionreturns.MultiPage1.value = 1
  txtEndDate2.SetFocus
  Exit Sub
  End If
  
  If txtCheckDate2.Text = "" Then
  MsgBox "Checked on page 2 is left blank", , "Error"
  Productionreturns.MultiPage1.value = 1
  txtCheckDate2.SetFocus
  Exit Sub
  End If
  
  lr = lr + 1
  sh.Cells(lr, "A").value = Me.lblGelCodeR.Caption
  sh.Cells(lr, "B").value = Me.lblProductNameR.Caption
  sh.Cells(lr, "C").value = Me.lblBatchNumberR.Caption
  sh.Cells(lr, "D").value = Me.lblBoxR.Caption
  sh.Cells(lr, "E").value = Me.txtStDate2.value
  sh.Cells(lr, "F").value = Me.txtCorrectBy2.value
  sh.Cells(lr, "G").value = Me.txtEndDate2.value
  sh.Cells(lr, "H").value = Me.txtCheckDate2.value
  sh.Cells(lr, "I").value = Me.cboDocument2.value
  sh.Cells(lr, "J").value = Me.cboDocumentPart2.value
  sh.Cells(lr, "K").value = Me.cboPart2.value
  End If
    
  'PAGE 3
  'If Me.control_a.value <> "" Then
  'lr = lr + 1
  'sh.Cells(lr, "A").value = Me.control_a.value
  'sh.Cells(lr, "B").value = Me.control_b.value
  'sh.Cells(lr, "C").value = Me.control_c.value
  'End If

  Call MsgBox("A new observation has been added", vbInformation, "Add observation")
    
  SortIt
  Unload Me
  On Error GoTo 0
  Exit Sub
 
cmdAdd_Click_Error:
  MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure cmdAddObservation_Click of Form Productionreturns"
End Sub
[/code[

Thanks in advance!
 
Upvote 0

Excel Facts

When did Power Query debut in Excel?
Although it was an add-in in Excel 2010 & Excel 2013, Power Query became a part of Excel in 2016, in Data, Get & Transform Data.
First you must put all the validations, since you finish making all the validations then you pass the data to the sheet.
 
Upvote 0
Thought i understand you but the turn out tells me different
Placed the validations to the top (if im right).

The problem of passing through data when not the required textboxes are filled is fixed now..

But;

Now when i fill page 1 correctly i get the message that an observation is added but there is not data passed through.
When i fill page 1 and 2 correctly the data is passed through correctly.

Code: 
Private Sub cmdAddOberservation_Click()
  Dim fTextBox As Object, xEptTxtName As String
  Dim sh As Worksheet, lr As Long

  Set sh = Sheets("Observations")
 
  If txtStDate.Text = "" Then
  MsgBox "Date of observation is left blank", , "Error"
  Productionreturns.MultiPage1.value = 0
  txtStDate.SetFocus
  Exit Sub
  End If
 
  If txtCorrectBy.Text = "" Then
  MsgBox "To correct by is left blank", , "Error"
  Productionreturns.MultiPage1.value = 0
  txtCorrectBy.SetFocus
  Exit Sub
  End If
 
  If txtEndDate.Text = "" Then
  MsgBox "Correction performed is left blank", , "Error"
  Productionreturns.MultiPage1.value = 0
  txtEndDate.SetFocus
  Exit Sub
  End If
 
  If txtCheckDate.Text = "" Then
  MsgBox "Checked on is left blank", , "Error"
  Productionreturns.MultiPage1.value = 0
  txtCheckDate.SetFocus
  Exit Sub
  End If
  End If
 
  If Me.txtStDate2.Text <> "" Then
 
  If txtCorrectBy2.Text = "" Then
  MsgBox "To correct by on page 2 is left blank", , "Error"
  Productionreturns.MultiPage1.value = 1
  txtCorrectBy2.SetFocus
  Exit Sub
  End If
 
  If txtEndDate2.Text = "" Then
  MsgBox "Correction performed on page 2 is left blank", , "Error"
  Productionreturns.MultiPage1.value = 1
  txtEndDate2.SetFocus
  Exit Sub
  End If
 
  If txtCheckDate2.Text = "" Then
  MsgBox "Checked on page 2 is left blank", , "Error"
  Productionreturns.MultiPage1.value = 1
  txtCheckDate2.SetFocus
  Exit Sub
  End If
   
  'PAGE 1
  lr = sh.Range("A" & Rows.Count).End(xlUp).Row + 1
  sh.Cells(lr, "A").value = Me.lblGelCodeR.Caption
  sh.Cells(lr, "B").value = Me.lblProductNameR.Caption
  sh.Cells(lr, "C").value = Me.lblBatchNumberR.Caption
  sh.Cells(lr, "D").value = Me.lblBoxR.Caption
  sh.Cells(lr, "E").value = Me.txtStDate.value
  sh.Cells(lr, "F").value = Me.txtCorrectBy.value
  sh.Cells(lr, "G").value = Me.txtEndDate.value
  sh.Cells(lr, "H").value = Me.txtCheckDate.value
  sh.Cells(lr, "I").value = Me.cboDocument.value
  sh.Cells(lr, "J").value = Me.cboDocumentPart.value
  sh.Cells(lr, "K").value = Me.cboPart.value
 
  'PAGE 2
  If Me.txtStDate2.Text <> "" Then
   
  lr = lr + 1
  sh.Cells(lr, "A").value = Me.lblGelCodeR.Caption
  sh.Cells(lr, "B").value = Me.lblProductNameR.Caption
  sh.Cells(lr, "C").value = Me.lblBatchNumberR.Caption
  sh.Cells(lr, "D").value = Me.lblBoxR.Caption
  sh.Cells(lr, "E").value = Me.txtStDate2.value
  sh.Cells(lr, "F").value = Me.txtCorrectBy2.value
  sh.Cells(lr, "G").value = Me.txtEndDate2.value
  sh.Cells(lr, "H").value = Me.txtCheckDate2.value
  sh.Cells(lr, "I").value = Me.cboDocument2.value
  sh.Cells(lr, "J").value = Me.cboDocumentPart2.value
  sh.Cells(lr, "K").value = Me.cboPart2.value
  End If
  End If

  Call MsgBox("A new observation has been added", vbInformation, "Add observation")
   
  SortIt
  Unload Me
  On Error GoTo 0
  Exit Sub

cmdAdd_Click_Error:
  MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure cmdAddObservation_Click of Form Productionreturns"
End Sub

The problem of passing through data to early is solved
 
Upvote 0
Try this

VBA Code: 
Private Sub cmdAddOberservation_Click()
  Dim fTextBox As Object, xEptTxtName As String
  Dim sh As Worksheet, lr As Long

  Set sh = Sheets("Observations")
 
 'VALIDATIONS PAGE1
 
  If txtStDate.Text = "" Then
    MsgBox "Date of observation is left blank", , "Error"
    Productionreturns.MultiPage1.Value = 0
    txtStDate.SetFocus
    Exit Sub
  End If
 
  If txtCorrectBy.Text = "" Then
    MsgBox "To correct by is left blank", , "Error"
    Productionreturns.MultiPage1.Value = 0
    txtCorrectBy.SetFocus
    Exit Sub
  End If
 
  If txtEndDate.Text = "" Then
    MsgBox "Correction performed is left blank", , "Error"
    Productionreturns.MultiPage1.Value = 0
    txtEndDate.SetFocus
    Exit Sub
  End If
 
  If txtCheckDate.Text = "" Then
    MsgBox "Checked on is left blank", , "Error"
    Productionreturns.MultiPage1.Value = 0
    txtCheckDate.SetFocus
    Exit Sub
  End If
 
 'VALIDATIONS PAGE2
  If Me.txtStDate2.Text <> "" Then
 
    If txtCorrectBy2.Text = "" Then
      MsgBox "To correct by on page 2 is left blank", , "Error"
      Productionreturns.MultiPage1.Value = 1
      txtCorrectBy2.SetFocus
      Exit Sub
    End If
 
    If txtEndDate2.Text = "" Then
      MsgBox "Correction performed on page 2 is left blank", , "Error"
      Productionreturns.MultiPage1.Value = 1
      txtEndDate2.SetFocus
      Exit Sub
    End If

    If txtCheckDate2.Text = "" Then
      MsgBox "Checked on page 2 is left blank", , "Error"
      Productionreturns.MultiPage1.Value = 1
      txtCheckDate2.SetFocus
      Exit Sub
    End If
  End If
 
  'PAGE 1
  lr = sh.Range("A" & Rows.Count).End(xlUp).Row + 1
  sh.Cells(lr, "A").Value = Me.lblGelCodeR.Caption
  sh.Cells(lr, "B").Value = Me.lblProductNameR.Caption
  sh.Cells(lr, "C").Value = Me.lblBatchNumberR.Caption
  sh.Cells(lr, "D").Value = Me.lblBoxR.Caption
  sh.Cells(lr, "E").Value = Me.txtStDate.Value
  sh.Cells(lr, "F").Value = Me.txtCorrectBy.Value
  sh.Cells(lr, "G").Value = Me.txtEndDate.Value
  sh.Cells(lr, "H").Value = Me.txtCheckDate.Value
  sh.Cells(lr, "I").Value = Me.cboDocument.Value
  sh.Cells(lr, "J").Value = Me.cboDocumentPart.Value
  sh.Cells(lr, "K").Value = Me.cboPart.Value
 
  'PAGE 2
  If Me.txtStDate2.Text <> "" Then
    lr = lr + 1
    sh.Cells(lr, "A").Value = Me.lblGelCodeR.Caption
    sh.Cells(lr, "B").Value = Me.lblProductNameR.Caption
    sh.Cells(lr, "C").Value = Me.lblBatchNumberR.Caption
    sh.Cells(lr, "D").Value = Me.lblBoxR.Caption
    sh.Cells(lr, "E").Value = Me.txtStDate2.Value
    sh.Cells(lr, "F").Value = Me.txtCorrectBy2.Value
    sh.Cells(lr, "G").Value = Me.txtEndDate2.Value
    sh.Cells(lr, "H").Value = Me.txtCheckDate2.Value
    sh.Cells(lr, "I").Value = Me.cboDocument2.Value
    sh.Cells(lr, "J").Value = Me.cboDocumentPart2.Value
    sh.Cells(lr, "K").Value = Me.cboPart2.Value
  End If
 
  Call MsgBox("A new observation has been added", vbInformation, "Add observation")
  
  SortIt
  Unload Me
  On Error GoTo 0
  Exit Sub

cmdAdd_Click_Error:
  MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure cmdAddObservation_Click of Form Productionreturns"
End Sub
 
Upvote 0
You must log in or register to reply here.

Forum statistics

Threads
1,214,991
Messages
6,122,628
Members
449,095
Latest member
bsb1122

Share this page

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