User form not adding data to sheet

[Ashleytaylor1702]

Hi,

Can any one have a look at the following and see if I am missing anything obvious

When i run the user form I get no errors but no text is entered to relevant cells

Private Sub cmdAddTooling_Click()
Dim wks As Worksheet
Dim AddNew As Range
Set wks = Sheet1
Set AddNew = wks.Range("A65356").End(xlUp).Offset(1, 0)

AddNew.Offset(0, 0).Value = txtPartNumber.Text
AddNew.Offset(0, 1).Value = txtTool.Text
AddNew.Offset(0, 2).Value = txtDrawing.Text
AddNew.Offset(0, 3).Value = txtNumber.Text
End Sub

Also could the same

AddNew.Offset(0, 0).Value = txtPartNumber.Text

be used for a combo box?

Many Thanks

[vba_php]

have you tried adding to the uf qualifier?

AddNew.Offset(0, 0).Value = USERFORM_name.txtPartNumber

the code works fine for me:

[Ashleytaylor1702]

Just tried that and still no joy

[bakerman2]

Are you sure your column A is empty below the last entered data?

Because otherwise you are entering data somewhere down your worksheet.

Also Range("A65536") is oldskool, use Range("A" & wks.Rows.Count) instead.

[Ashleytaylor1702]

I have just checked and Column A is empty and I have amended the code but still not working

[romperstomper]

If you're not getting an error, then the data is going somewhere. Are you sure you're looking at the correct sheet? Sheet1 is a codename and is not necessarily the sheet with Sheet1 as its tab caption.

[Ashleytaylor1702]

Thank you for your help all solved

[vba_php]

If you're not getting an error, then the data is going somewhere. Are you sure you're looking at the correct sheet? Sheet1 is a codename and is not necessarily the sheet with Sheet1 as its tab caption.

I ran it with SHEET1 and I had another word as the caption. apparently that matters not.

[Ashleytaylor1702]

Me again!

I need to stop users entering duplicate information

How can I change the code so that the User Form checks if the Value already exists in each Column and if it does display a msg box and not allow them to enter a duplicate?
here is my existing code:

Option Explicit

Private Sub CommandButton1_Click()
Private Sub cmdAddTooling_Click()
Dim wks As Worksheet
Dim AddNew As Range
Set wks = Sheet6
Set AddNew = wks.Range("A65356").End(xlUp).Offset(1, 0)

AddNew.Offset(0, 0).Value = UserForm1.txtLine
AddNew.Offset(0, 1).Value = UserForm1.txtToolType
AddNew.Offset(0, 2).Value = UserForm1.txtPartNumber
AddNew.Offset(0, 3).Value = UserForm1.txtTCNNumber
AddNew.Offset(0, 4).Value = UserForm1.txtDrawingNumber
AddNew.Offset(0, 5).Value = UserForm1.txtNumber
AddNew.Offset(0, 6).Value = UserForm1.txtMaterial





End Sub

Private Sub cmdClose_Click()
Dim iexit As VbMsgBoxResult
iexit = MsgBox("Are you sure you want to close the Window", vbQuestion + vbYesNo, "Data Entry Form")

If iexit = vbYes Then
Unload Me
End If

End Sub


Private Sub cmdClearAllFields_Click()

Dim icontrol As Control

For Each icontrol In Me.Controls

If icontrol.Name Like "txt*" Then icontrol = vbNullString

Next

End Sub

Private Sub Workbook_Open()
frmEmpData.Show
End Sub



End Sub

Many Thanks

[romperstomper]

Do you mean it should check all the columns and not allow the entry at all if any of them are duplicated, or check each column and only disallow each column if it's a duplicate?

[Ashleytaylor1702]

It should check all columns please and not allow entry if any are duplicated

Thanks

[romperstomper]

Just FYI the code you posted would never run, as you have put several subroutines inside another one.

Try this:

Private Sub cmdAddTooling_Click()
Dim wks As Worksheet
Dim AddNew As Range
Set wks = Sheet6
Set AddNew = wks.Range("A65356").End(xlUp).Offset(1, 0)
with application.worksheetfunction
   if .countif(addnew.entirecolumn, me.txtLine) = 0 then
      if .countif(addnew.entirecolumn.offset(, 1), me.txtToolType) = 0 then
         if .countif(addnew.entirecolumn.offset(, 2), me.txtPartNumber) = 0 then
            if .countif(addnew.entirecolumn.offset(, 3), me.txtTCNNumber) = 0 then
               if .countif(addnew.entirecolumn.offset(, 4), me.txtDrawingNumber) = 0 then
                  if .countif(addnew.entirecolumn.offset(, 5), me.txtNumber) = 0 then
                     if .countif(addnew.entirecolumn.offset(, 6), me.txtMaterial) = 0 then
                         AddNew.Offset(0, 0).Value = me.txtLine
                         AddNew.Offset(0, 1).Value = me.txtToolType
                         AddNew.Offset(0, 2).Value = me.txtPartNumber
                         AddNew.Offset(0, 3).Value = me.txtTCNNumber
                         AddNew.Offset(0, 4).Value = me.txtDrawingNumber
                         AddNew.Offset(0, 5).Value = me.txtNumber
                         AddNew.Offset(0, 6).Value = me.txtMaterial
                      End If
                   End If
               End If
            End If
        End If
     End If
   End If
End With

End Sub

You might want to add a message in an Else clause for each If just to let the user know why the data isn't being added!

[Ashleytaylor1702]

Could you please give an example of the position of the else clause?

[romperstomper]

You would have one before each End If line, so that you can specify which value is a duplicate.

[Ashleytaylor1702]

Hi,

Just tried that but it only returns the last msg box regardless of the duplicate

 If .CountIf(AddNew.EntireColumn.Offset(, 3), Me.txtTCNNumber) = 0 Then
            
            
            
                    If .CountIf(AddNew.EntireColumn.Offset(, 4), Me.txtDrawingNumber) = 0 Then
                    
                    
                                 If .CountIf(AddNew.EntireColumn.Offset(, 5), Me.txtTRSNumber) = 0 Then
            
                                 
                             
            
                        
                         AddNew.Offset(0, 3).Value = Me.txtTCNNumber
                         AddNew.Offset(0, 4).Value = Me.txtDrawingNumber
                         AddNew.Offset(0, 5).Value = Me.txtTRSNumber
                         
                        
                         
                            ElseIf .CountIf(AddNew.EntireColumn.Offset(, 5), Me.txtTRSNumber) = 1 Then
                            
                            MsgBox "This TRS Number is already in use!"
                        
                        End If
                        
                        ElseIf .CountIf(AddNew.EntireColumn.Offset(, 4), Me.txtDrawingNumber) = 1 Then
                    
                         MsgBox "This Drawing Number is already in use!"
                         
                   End If
                   
                   Else
                    MsgBox "This TCN Number is already in use!"
            End If
      
   
End With

End Sub

Any ideas?

[Ashleytaylor1702]

I have got this working now however I didn't explain what I needed to achieve very well:

If a duplicate is found in the columns then I would like an error message as well as not being able to enter any non duplicated information into the row

Also I would like the default value in the TCNNumber input box to default to +1 of the the highest number in that column

Thanks for all your help

[bakerman2]

How about this.

Private Sub cmdAddTooling_Click()
    Dim wks As Worksheet, AddNew As Range
    Dim myarr, i As Long, msg As String
    
    Set wks = Sheet6
    Set AddNew = wks.Range("A" & wks.Rows.Count).End(xlUp).Offset(1)

    myarr = Array(Me.txtLine, Me.txtToolType, Me.txtPartNumber, Me.txtTCNNumber, Me.txtDrawingNumber, Me.txtNumber, Me.txtMaterial)
    
    For i = 0 To 6
        If Application.CountIf(AddNew.EntireColumn.Offset(, i), myarr(i)) <> 0 Then msg = msg & "," & myarr(i)
    Next
    If msg <> "" Then MsgBox "These textboxes hold duplicate : " & Mid(msg, 2): Exit Sub

    AddNew.Offset(0, 0).Value = Me.txtLine
    AddNew.Offset(0, 1).Value = Me.txtToolType
    AddNew.Offset(0, 2).Value = Me.txtPartNumber
    AddNew.Offset(0, 3).Value = Me.txtTCNNumber
    AddNew.Offset(0, 4).Value = Me.txtDrawingNumber
    AddNew.Offset(0, 5).Value = Me.txtNumber
    AddNew.Offset(0, 6).Value = Me.txtMaterial

End Sub

[torachan]

How about uploading your workbook ??????????
Sixteen posts and barely one step forward.
torachan.

[BrunoCampanini]

Try this:

Private Sub cmdAddTooling_Click()
Dim AddNew As Range

Set AddNew = [Sheet1!A1].End(xlDown)
AddNew(2, 1) = "txtPartNumber"
AddNew(2, 2) = "txtTool"
AddNew(2, 3) = "txtDrawing"
AddNew(2, 4) = "txtNumber"

End Sub

[bakerman2]

Did you try the code provided in Post#16?